“EMA_5.5” besteht aus je 5 MZP im Pre- und im Post-Intervall. Dies sind die ursprünglich simulierten EMA-Daten von N = 8040 Personen (ursprünglich N = 100.000).
“EMA_30.30” besteht aus je 30 MZP im Pre- und im Post-Intervall. Diese wurden aus den ursprünglichen Simulationsdaten erweitert und umfassen dieselben N = 8040 Personen.
“EMA_5.5_Window” besteht aus je 5 MZP im Pre- und im Post-Intervall, wobei diese (pro Person) jeweils als zusammenhängendes Intervall (Window) zufällig aus den Gesamt-Intervallen ausgewählt wurden. Die Stichprobe umfasst dieselben N = 8040 Personen.
“EMA_5.5_Days” besteht aus je 5 MZP im Pre- und im Post-Intervall, wobei diese pro Person jeweils unzusammenhängend zufällig aus den Gesamt-Intervallen ausgewählt wurden. Die Stichprobe umfasst dieselben N = 8040 Personen.
# Ausschluss von Personen ohne Varianz in min. einem MZP-Intervall
# sd(c(1,1,1,1,2)) = 0.4472136 = min. SD bei 5 (nicht gleichen) MZP
# sd(c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2)) = 0.1825742 = min. SD bei 30 (nicht gleichen) MZP
EMA_5.5 = EMA_5.5 %>%
filter(ind.pretestSD != 0 & ind.posttestSD != 0)
EMA_30.30 = EMA_30.30 %>%
filter(ind.pretestSD != 0 & ind.posttestSD != 0)
EMA_5.5 = EMA_5.5 %>%
filter(ID_orig %in% EMA_30.30$ID1_PRE)
EMA_30.30 = EMA_30.30 %>%
filter(ID1_PRE %in% EMA_5.5$ID_orig)
EMA_5.5 = EMA_5.5 %>%
add_column(., .before = "ID_orig", ID = 1:nrow(.))
EMA_30.30 = EMA_30.30 %>%
add_column(., .before = "ID1_PRE", ID = 1:nrow(.))load("cor_04_k20/EMA_5.5_Window.RData")
load("cor_04_k20/EMA_5.5_Days.RData")
EMA_5.5_Window$PRE_Mean = apply(EMA_5.5_Window[pre_5mzp], 1, mean)
EMA_5.5_Window$POST_Mean = apply(EMA_5.5_Window[post_5mzp], 1, mean)
EMA_5.5_Window$MeanDiff = EMA_5.5_Window$PRE_Mean - EMA_5.5_Window$POST_Mean
EMA_5.5_Window$ind.pretestSD = apply(EMA_5.5_Window[pre_5mzp], 1, sd)
EMA_5.5_Window$ind.posttestSD = apply(EMA_5.5_Window[post_5mzp], 1, sd)
EMA_5.5_Days$PRE_Mean = apply(EMA_5.5_Days[pre_5mzp], 1, mean)
EMA_5.5_Days$POST_Mean = apply(EMA_5.5_Days[post_5mzp], 1, mean)
EMA_5.5_Days$MeanDiff = EMA_5.5_Days$PRE_Mean - EMA_5.5_Days$POST_Mean
EMA_5.5_Days$ind.pretestSD = apply(EMA_5.5_Days[pre_5mzp], 1, sd)
EMA_5.5_Days$ind.posttestSD = apply(EMA_5.5_Days[post_5mzp], 1, sd)# Ausschluss von Personen ohne Varianz in min. einem MZP-Intervall
EMA_5.5_Window = EMA_5.5_Window %>%
filter(ind.pretestSD != 0 & ind.posttestSD != 0)
EMA_5.5_Days = EMA_5.5_Days %>%
filter(ind.pretestSD != 0 & ind.posttestSD != 0)
EMA_5.5 = EMA_5.5 %>%
filter(ID %in% EMA_30.30$ID & ID %in% EMA_5.5_Window$ID & ID %in% EMA_5.5_Days$ID)
EMA_30.30 = EMA_30.30 %>%
filter(ID %in% EMA_5.5$ID & ID %in% EMA_5.5_Window$ID & ID %in% EMA_5.5_Days$ID)
EMA_5.5_Window = EMA_5.5_Window %>%
filter(ID %in% EMA_5.5$ID & ID %in% EMA_30.30$ID & ID %in% EMA_5.5_Days$ID)
EMA_5.5_Days = EMA_5.5_Days %>%
filter(ID %in% EMA_5.5$ID & ID %in% EMA_30.30$ID & ID %in% EMA_5.5_Window$ID)
EMA_5.5$ID = 1:nrow(EMA_5.5)
EMA_30.30$ID = 1:nrow(EMA_30.30)
EMA_5.5_Window$ID = 1:nrow(EMA_5.5_Window)
EMA_5.5_Days$ID = 1:nrow(EMA_5.5_Days)Beispiel-Verläufe in den 4 untersuchten Datensets
EMA_5.5 %>%
within(., {ind.pretestSD = round(ind.pretestSD, digits = 2)
ind.posttestSD = round(ind.posttestSD, digits = 2)}) %>%
head() %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
scroll_box(width = "100%")| ID | ID_orig | PRE1_1 | PRE1_2 | PRE1_3 | PRE1_4 | PRE1_5 | POST1_1 | POST1_2 | POST1_3 | POST1_4 | POST1_5 | PRE_Mean | POST_Mean | MeanDiff | ind.pretestSD | ind.posttestSD |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 1 | 9 | 8 | 14 | 10 | 17 | 5 | 2 | 2 | 6 | 3 | 11.6 | 3.6 | 8.0 | 3.78 | 1.82 |
| 2 | 3 | 8 | 9 | 11 | 12 | 7 | 5 | 4 | 5 | 7 | 2 | 9.4 | 4.6 | 4.8 | 2.07 | 1.82 |
| 3 | 4 | 11 | 10 | 5 | 7 | 5 | 18 | 7 | 9 | 5 | 14 | 7.6 | 10.6 | -3.0 | 2.79 | 5.32 |
| 4 | 5 | 12 | 7 | 14 | 12 | 12 | 10 | 12 | 6 | 6 | 7 | 11.4 | 8.2 | 3.2 | 2.61 | 2.68 |
| 5 | 6 | 12 | 12 | 14 | 8 | 9 | 1 | 1 | 8 | 13 | 8 | 11.0 | 6.2 | 4.8 | 2.45 | 5.17 |
| 6 | 7 | 8 | 15 | 8 | 8 | 8 | 3 | 4 | 4 | 6 | 11 | 9.4 | 5.6 | 3.8 | 3.13 | 3.21 |
Pre-Post-Verläufe für 9 zufällig gezogene Personen
rand = sample(EMA_5.5$ID, 9)
x = tibble(ID = c(rep(rand[1],times=11),
rep(rand[2],times=11),
rep(rand[3],times=11),
rep(rand[4],times=11),
rep(rand[5],times=11),
rep(rand[6],times=11),
rep(rand[7],times=11),
rep(rand[8],times=11),
rep(rand[9],times=11)),
MZP = rep(seq(as.Date("2020-01-01"), length.out=11, by="1 day"), times=9),
Score = c(as.numeric(EMA_5.5[rand[1],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[1],post_5mzp]),
as.numeric(EMA_5.5[rand[2],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[2],post_5mzp]),
as.numeric(EMA_5.5[rand[3],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[3],post_5mzp]),
as.numeric(EMA_5.5[rand[4],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[4],post_5mzp]),
as.numeric(EMA_5.5[rand[5],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[5],post_5mzp]),
as.numeric(EMA_5.5[rand[6],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[6],post_5mzp]),
as.numeric(EMA_5.5[rand[7],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[7],post_5mzp]),
as.numeric(EMA_5.5[rand[8],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[8],post_5mzp]),
as.numeric(EMA_5.5[rand[9],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[9],post_5mzp])))
x %>%
group_by(ID) %>%
plot_time_series(MZP, Score,
#.color_var = ID, # for multiple lines in one plot
#.color_lab = "ID",
.facet_ncol = 3,
.facet_scales = "fixed",
.interactive = TRUE,
.facet_collapse = FALSE,
.smooth = TRUE,
.smooth_degree = 2,
.smooth_alpha = 0.5,
.smooth_size = 0.2
)# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R
# EMA_5.5
# converting my dataframes to use in the same ggplot structure:
EMA_5.5_ts = EMA_5.5 %>%
select(ID, PRE_Mean, POST_Mean) %>%
pivot_longer(!ID, names_to = "Interval", values_to = "Mean") %>%
mutate(ID = as.factor(ID),
Interval = rep(c(1,2), times = nrow(EMA_5.5)))
save(EMA_5.5_ts, file = "Time Series Dataframes/k20_EMA_5.5_ts.RData")
###
load("Time Series Dataframes/k20_EMA_5.5_ts.RData")
# Repeated measures with box− and violin plots
EMA_5.5_ts$jit = jitter(EMA_5.5_ts$Interval, amount = .09)
Pre_Post_Box_Violin = ggplot(data = EMA_5.5_ts, aes(y = Mean)) +
geom_point(data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
alpha = .5) +
geom_point(data = EMA_5.5_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
alpha = .5) +
geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
geom_half_boxplot(
data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.25),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
fill = "dodgerblue", alpha = .5) +
geom_half_boxplot(
data = EMA_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .15),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
fill = "darkorange", alpha = .5) +
geom_half_violin(
data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = 1.3),
side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
geom_half_violin(
data = EMA_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .3),
side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
xlab("Interval") + ylab("PHQ-9 Mean Score") +
#ggtitle("EMA Data (5+5 Timepoints): Individual Pre-Post Means") +
#theme_classic() +
theme_bw() +
coord_cartesian(ylim = c(0, 24))
ggsave("Time Series Dataframes/k20_EMA_5.5_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_EMA_5.5_Pre_Post_Box_Violin.RData")
# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = EMA_5.5_ts %>% filter(Interval == "1") %>% summarise(mean(Mean)) %>% as.numeric()
score_mean_2 = EMA_5.5_ts %>% filter(Interval == "2") %>% summarise(mean(Mean)) %>% as.numeric()
score_median1 = EMA_5.5_ts %>% filter(Interval == "1") %>% summarise(median(Mean)) %>% as.numeric()
score_median2 = EMA_5.5_ts %>% filter(Interval == "2") %>% summarise(median(Mean)) %>% as.numeric()
score_sd_1 = EMA_5.5_ts %>% filter(Interval == "1") %>% summarise(sd(Mean)) %>% as.numeric()
score_sd_2 = EMA_5.5_ts %>% filter(Interval == "2") %>% summarise(sd(Mean)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(EMA_5.5))
score_se_2 = score_sd_2/sqrt(nrow(EMA_5.5))
score_ci_1 = EMA_5.5_ts %>% filter(Interval == "1") %>% pull(Mean) %>% CI(., ci = 0.95)
score_ci_2 = EMA_5.5_ts %>% filter(Interval == "2") %>% pull(Mean) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(EMA_5.5), nrow(EMA_5.5))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c(as.numeric(score_ci_1[1] - score_ci_1[3]), as.numeric(score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)
# EMA_5.5_ts$jit = jitter(EMA_5.5_ts$Interval, amount = .09) #already created above
x_tick_means = c(.87, 2.13)
Pre_Post_Box_Violin_Mean_CI = ggplot(data = EMA_5.5_ts, aes(y = Mean)) +
geom_point(data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
alpha = .6) +
geom_point(data = EMA_5.5_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
alpha = .6) +
geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
geom_half_boxplot(
data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.28),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
fill = "dodgerblue") +
geom_half_boxplot(
data = EMA_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .18),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
fill = "darkorange") +
geom_half_violin(
data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.3),
side = "l", fill = "dodgerblue") +
geom_half_violin(
data = EMA_5.5_ts %>% filter(Interval == "2"),aes(x = Interval, y = Mean), position = position_nudge(x = .3),
side = "r", fill = "darkorange") +
geom_point(data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1]),
position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
geom_errorbar(data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1],
ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
geom_point(data = EMA_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2]),
position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
geom_errorbar(data = EMA_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2],
ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]),
position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
xlab("Interval") + ylab("PHQ-9 Mean Score") +
#ggtitle("EMA Data (5+5 Timepoints): Individual Pre-Post Means") +
#theme_classic() +
theme_bw() +
coord_cartesian(ylim = c(0, 24))
ggsave("Time Series Dataframes/k20_EMA_5.5_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_EMA_5.5_Pre_Post_Box_Violin_Mean_CI.RData")#knitr::include_graphics("Time Series Dataframes/k20_EMA_5.5_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_EMA_5.5_Pre-Post_Box_Violin_Mean+CI.jpg")EMA_30.30 %>%
select(-(ID1_PRE:ID6_POST)) %>%
within(., {ind.pretestSD = round(ind.pretestSD, digits = 2)
ind.posttestSD = round(ind.posttestSD, digits = 2)}) %>%
head() %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
scroll_box(width = "100%")| ID | PRE1_1 | PRE1_2 | PRE1_3 | PRE1_4 | PRE1_5 | PRE1_6 | PRE1_7 | PRE1_8 | PRE1_9 | PRE1_10 | PRE1_11 | PRE1_12 | PRE1_13 | PRE1_14 | PRE1_15 | PRE1_16 | PRE1_17 | PRE1_18 | PRE1_19 | PRE1_20 | PRE1_21 | PRE1_22 | PRE1_23 | PRE1_24 | PRE1_25 | PRE1_26 | PRE1_27 | PRE1_28 | PRE1_29 | PRE1_30 | POST1_1 | POST1_2 | POST1_3 | POST1_4 | POST1_5 | POST1_6 | POST1_7 | POST1_8 | POST1_9 | POST1_10 | POST1_11 | POST1_12 | POST1_13 | POST1_14 | POST1_15 | POST1_16 | POST1_17 | POST1_18 | POST1_19 | POST1_20 | POST1_21 | POST1_22 | POST1_23 | POST1_24 | POST1_25 | POST1_26 | POST1_27 | POST1_28 | POST1_29 | POST1_30 | PRE_Mean | POST_Mean | MeanDiff | ind.pretestSD | ind.posttestSD |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 9 | 8 | 14 | 10 | 17 | 11 | 11 | 10 | 18 | 8 | 7 | 8 | 14 | 15 | 14 | 9 | 8 | 10 | 14 | 17 | 8 | 14 | 14 | 15 | 7 | 11 | 14 | 16 | 11 | 6 | 5 | 2 | 2 | 6 | 3 | 2 | 5 | 3 | 2 | 6 | 4 | 4 | 1 | 6 | 3 | 3 | 4 | 4 | 6 | 1 | 3 | 2 | 2 | 6 | 5 | 3 | 4 | 1 | 4 | 6 | 11.6 | 3.6 | 8.0 | 3.44 | 1.65 |
| 2 | 8 | 9 | 11 | 12 | 7 | 11 | 10 | 11 | 9 | 6 | 11 | 9 | 12 | 8 | 7 | 9 | 12 | 11 | 8 | 7 | 11 | 7 | 8 | 9 | 12 | 12 | 9 | 8 | 11 | 7 | 5 | 4 | 5 | 7 | 2 | 6 | 3 | 7 | 4 | 3 | 6 | 4 | 3 | 7 | 3 | 3 | 4 | 7 | 6 | 3 | 6 | 7 | 3 | 4 | 3 | 7 | 2 | 5 | 4 | 5 | 9.4 | 4.6 | 4.8 | 1.89 | 1.65 |
| 3 | 11 | 10 | 5 | 7 | 5 | 9 | 10 | 9 | 7 | 3 | 9 | 10 | 9 | 7 | 3 | 5 | 10 | 11 | 7 | 5 | 10 | 7 | 5 | 5 | 11 | 7 | 10 | 9 | 9 | 3 | 18 | 7 | 9 | 5 | 14 | 8 | 3 | 16 | 11 | 15 | 3 | 8 | 15 | 11 | 16 | 12 | 8 | 5 | 19 | 9 | 16 | 8 | 15 | 11 | 3 | 11 | 18 | 5 | 6 | 13 | 7.6 | 10.6 | -3.0 | 2.54 | 4.84 |
| 4 | 12 | 7 | 14 | 12 | 12 | 10 | 12 | 8 | 12 | 15 | 10 | 10 | 16 | 11 | 10 | 13 | 9 | 11 | 15 | 9 | 10 | 16 | 10 | 11 | 10 | 11 | 10 | 10 | 16 | 10 | 10 | 12 | 6 | 6 | 7 | 12 | 10 | 6 | 6 | 7 | 8 | 11 | 10 | 8 | 4 | 12 | 6 | 6 | 7 | 10 | 11 | 5 | 7 | 7 | 11 | 7 | 10 | 10 | 10 | 4 | 11.4 | 8.2 | 3.2 | 2.37 | 2.44 |
| 5 | 12 | 12 | 14 | 8 | 9 | 8 | 9 | 12 | 14 | 12 | 13 | 14 | 10 | 10 | 8 | 14 | 10 | 13 | 8 | 10 | 13 | 11 | 7 | 11 | 13 | 7 | 11 | 13 | 13 | 11 | 1 | 1 | 8 | 13 | 8 | 14 | 9 | 3 | 3 | 2 | 3 | 15 | 5 | 2 | 6 | 10 | 5 | 1 | 2 | 13 | 2 | 15 | 6 | 5 | 3 | 3 | 3 | 2 | 9 | 14 | 11.0 | 6.2 | 4.8 | 2.23 | 4.70 |
| 6 | 8 | 15 | 8 | 8 | 8 | 14 | 10 | 10 | 7 | 6 | 11 | 14 | 8 | 6 | 8 | 10 | 10 | 12 | 11 | 4 | 14 | 11 | 6 | 8 | 8 | 14 | 10 | 10 | 7 | 6 | 3 | 4 | 4 | 6 | 11 | 6 | 4 | 4 | 3 | 11 | 4 | 6 | 9 | 1 | 8 | 1 | 6 | 8 | 9 | 4 | 8 | 6 | 4 | 9 | 1 | 10 | 3 | 4 | 8 | 3 | 9.4 | 5.6 | 3.8 | 2.85 | 2.92 |
Pre-Post-Verläufe für 9 zufällig gezogene Personen
rand = sample(EMA_30.30$ID, 9)
x = tibble(ID = c(rep(rand[1],times=61),
rep(rand[2],times=61),
rep(rand[3],times=61),
rep(rand[4],times=61),
rep(rand[5],times=61),
rep(rand[6],times=61),
rep(rand[7],times=61),
rep(rand[8],times=61),
rep(rand[9],times=61)),
MZP = rep(seq(as.Date("2020-01-01"), length.out=61, by="1 day"), times=9),
Score = c(as.numeric(EMA_30.30[rand[1],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[1],post_30mzp]),
as.numeric(EMA_30.30[rand[2],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[2],post_30mzp]),
as.numeric(EMA_30.30[rand[3],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[3],post_30mzp]),
as.numeric(EMA_30.30[rand[4],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[4],post_30mzp]),
as.numeric(EMA_30.30[rand[5],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[5],post_30mzp]),
as.numeric(EMA_30.30[rand[6],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[6],post_30mzp]),
as.numeric(EMA_30.30[rand[7],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[7],post_30mzp]),
as.numeric(EMA_30.30[rand[8],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[8],post_30mzp]),
as.numeric(EMA_30.30[rand[9],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[9],post_30mzp])))
x %>%
group_by(ID) %>%
plot_time_series(MZP, Score,
#.color_var = ID, # for multiple lines in one plot
#.color_lab = "ID",
.facet_ncol = 3,
.facet_scales = "fixed",
.interactive = TRUE,
.facet_collapse = FALSE,
.smooth = TRUE,
.smooth_degree = 2,
.smooth_alpha = 0.5,
.smooth_size = 0.2
)# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R
# EMA_30.30
# converting my dataframes to use in the same ggplot structure:
EMA_30.30_ts = EMA_30.30 %>%
select(ID, PRE_Mean, POST_Mean) %>%
pivot_longer(!ID, names_to = "Interval", values_to = "Mean") %>%
mutate(ID = as.factor(ID),
Interval = rep(c(1,2), times = nrow(EMA_30.30)))
save(EMA_30.30_ts, file = "Time Series Dataframes/k20_EMA_30.30_ts.RData")
###
load("Time Series Dataframes/k20_EMA_30.30_ts.RData")
# Repeated measures with box− and violin plots
EMA_30.30_ts$jit = jitter(EMA_30.30_ts$Interval, amount = .09)
Pre_Post_Box_Violin = ggplot(data = EMA_30.30_ts, aes(y = Mean)) +
geom_point(data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
alpha = .5) +
geom_point(data = EMA_30.30_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
alpha = .5) +
geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
geom_half_boxplot(
data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.25),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
fill = "dodgerblue", alpha = .5) +
geom_half_boxplot(
data = EMA_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .15),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
fill = "darkorange", alpha = .5) +
geom_half_violin(
data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = 1.3),
side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
geom_half_violin(
data = EMA_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .3),
side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
xlab("Interval") + ylab("PHQ-9 Mean Score") +
#ggtitle("EMA Data (30+30 Timepoints): Individual Pre-Post Means") +
#theme_classic() +
theme_bw() +
coord_cartesian(ylim = c(0, 24))
ggsave("Time Series Dataframes/k20_EMA_30.30_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_EMA_30.30_Pre_Post_Box_Violin.RData")
# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = EMA_30.30_ts %>% filter(Interval == "1") %>% summarise(mean(Mean)) %>% as.numeric()
score_mean_2 = EMA_30.30_ts %>% filter(Interval == "2") %>% summarise(mean(Mean)) %>% as.numeric()
score_median1 = EMA_30.30_ts %>% filter(Interval == "1") %>% summarise(median(Mean)) %>% as.numeric()
score_median2 = EMA_30.30_ts %>% filter(Interval == "2") %>% summarise(median(Mean)) %>% as.numeric()
score_sd_1 = EMA_30.30_ts %>% filter(Interval == "1") %>% summarise(sd(Mean)) %>% as.numeric()
score_sd_2 = EMA_30.30_ts %>% filter(Interval == "2") %>% summarise(sd(Mean)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(EMA_30.30))
score_se_2 = score_sd_2/sqrt(nrow(EMA_30.30))
score_ci_1 = EMA_30.30_ts %>% filter(Interval == "1") %>% pull(Mean) %>% CI(., ci = 0.95)
score_ci_2 = EMA_30.30_ts %>% filter(Interval == "2") %>% pull(Mean) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(EMA_30.30), nrow(EMA_30.30))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c(as.numeric(score_ci_1[1] - score_ci_1[3]), as.numeric(score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)
# EMA_30.30_ts$jit = jitter(EMA_30.30_ts$Interval, amount = .09) #already created above
x_tick_means = c(.87, 2.13)
Pre_Post_Box_Violin_Mean_CI = ggplot(data = EMA_30.30_ts, aes(y = Mean)) +
geom_point(data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
alpha = .6) +
geom_point(data = EMA_30.30_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
alpha = .6) +
geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
geom_half_boxplot(
data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.28),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
fill = "dodgerblue") +
geom_half_boxplot(
data = EMA_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .18),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
fill = "darkorange") +
geom_half_violin(
data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.3),
side = "l", fill = "dodgerblue") +
geom_half_violin(
data = EMA_30.30_ts %>% filter(Interval == "2"),aes(x = Interval, y = Mean), position = position_nudge(x = .3),
side = "r", fill = "darkorange") +
geom_point(data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1]),
position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
geom_errorbar(data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1],
ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
geom_point(data = EMA_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2]),
position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
geom_errorbar(data = EMA_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2],
ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]),
position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
xlab("Interval") + ylab("PHQ-9 Mean Score") +
#ggtitle("EMA Data (30+30 Timepoints): Individual Pre-Post Means") +
#theme_classic() +
theme_bw() +
coord_cartesian(ylim = c(0, 24))
ggsave("Time Series Dataframes/k20_EMA_30.30_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_EMA_30.30_Pre_Post_Box_Violin_Mean_CI.RData")#knitr::include_graphics("Time Series Dataframes/k20_EMA_30.30_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_EMA_30.30_Pre-Post_Box_Violin_Mean+CI.jpg")EMA_5.5_Window %>%
within(., {ind.pretestSD = round(ind.pretestSD, digits = 2)
ind.posttestSD = round(ind.posttestSD, digits = 2)}) %>%
head() %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
scroll_box(width = "100%")| ID | Pre_MZP1 | Pre_MZP2 | Pre_MZP3 | Pre_MZP4 | Pre_MZP5 | Post_MZP1 | Post_MZP2 | Post_MZP3 | Post_MZP4 | Post_MZP5 | PRE1_1 | PRE1_2 | PRE1_3 | PRE1_4 | PRE1_5 | POST1_1 | POST1_2 | POST1_3 | POST1_4 | POST1_5 | PRE_Mean | POST_Mean | MeanDiff | ind.pretestSD | ind.posttestSD |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | PRE1_1 | PRE1_2 | PRE1_3 | PRE1_4 | PRE1_5 | POST1_25 | POST1_26 | POST1_27 | POST1_28 | POST1_29 | 9 | 8 | 14 | 10 | 17 | 5 | 3 | 4 | 1 | 4 | 11.6 | 3.4 | 8.2 | 3.78 | 1.52 |
| 2 | PRE1_10 | PRE1_11 | PRE1_12 | PRE1_13 | PRE1_14 | POST1_4 | POST1_5 | POST1_6 | POST1_7 | POST1_8 | 6 | 11 | 9 | 12 | 8 | 7 | 2 | 6 | 3 | 7 | 9.2 | 5.0 | 4.2 | 2.39 | 2.35 |
| 3 | PRE1_18 | PRE1_19 | PRE1_20 | PRE1_21 | PRE1_22 | POST1_26 | POST1_27 | POST1_28 | POST1_29 | POST1_30 | 11 | 7 | 5 | 10 | 7 | 11 | 18 | 5 | 6 | 13 | 8.0 | 10.6 | -2.6 | 2.45 | 5.32 |
| 4 | PRE1_17 | PRE1_18 | PRE1_19 | PRE1_20 | PRE1_21 | POST1_15 | POST1_16 | POST1_17 | POST1_18 | POST1_19 | 9 | 11 | 15 | 9 | 10 | 4 | 12 | 6 | 6 | 7 | 10.8 | 7.0 | 3.8 | 2.49 | 3.00 |
| 5 | PRE1_24 | PRE1_25 | PRE1_26 | PRE1_27 | PRE1_28 | POST1_7 | POST1_8 | POST1_9 | POST1_10 | POST1_11 | 11 | 13 | 7 | 11 | 13 | 9 | 3 | 3 | 2 | 3 | 11.0 | 4.0 | 7.0 | 2.45 | 2.83 |
| 6 | PRE1_4 | PRE1_5 | PRE1_6 | PRE1_7 | PRE1_8 | POST1_25 | POST1_26 | POST1_27 | POST1_28 | POST1_29 | 8 | 8 | 14 | 10 | 10 | 1 | 10 | 3 | 4 | 8 | 10.0 | 5.2 | 4.8 | 2.45 | 3.70 |
Pre-Post-Verläufe für 9 zufällig gezogene Personen
rand = sample(EMA_5.5_Window$ID, 9)
x = tibble(ID = c(rep(rand[1],times=11),
rep(rand[2],times=11),
rep(rand[3],times=11),
rep(rand[4],times=11),
rep(rand[5],times=11),
rep(rand[6],times=11),
rep(rand[7],times=11),
rep(rand[8],times=11),
rep(rand[9],times=11)),
MZP = rep(seq(as.Date("2020-01-01"), length.out=11, by="1 day"), times=9),
Score = c(as.numeric(EMA_5.5_Window[rand[1],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[1],post_5mzp]),
as.numeric(EMA_5.5_Window[rand[2],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[2],post_5mzp]),
as.numeric(EMA_5.5_Window[rand[3],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[3],post_5mzp]),
as.numeric(EMA_5.5_Window[rand[4],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[4],post_5mzp]),
as.numeric(EMA_5.5_Window[rand[5],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[5],post_5mzp]),
as.numeric(EMA_5.5_Window[rand[6],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[6],post_5mzp]),
as.numeric(EMA_5.5_Window[rand[7],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[7],post_5mzp]),
as.numeric(EMA_5.5_Window[rand[8],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[8],post_5mzp]),
as.numeric(EMA_5.5_Window[rand[9],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[9],post_5mzp])))
x %>%
group_by(ID) %>%
plot_time_series(MZP, Score,
#.color_var = ID, # for multiple lines in one plot
#.color_lab = "ID",
.facet_ncol = 3,
.facet_scales = "fixed",
.interactive = TRUE,
.facet_collapse = FALSE,
.smooth = TRUE,
.smooth_degree = 2,
.smooth_alpha = 0.5,
.smooth_size = 0.2
)# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R
# EMA_5.5_Window
# converting my dataframes to use in the same ggplot structure:
EMA_5.5_Window_ts = EMA_5.5_Window %>%
select(ID, PRE_Mean, POST_Mean) %>%
pivot_longer(!ID, names_to = "Interval", values_to = "Mean") %>%
mutate(ID = as.factor(ID),
Interval = rep(c(1,2), times = nrow(EMA_5.5_Window)))
save(EMA_5.5_Window_ts, file = "Time Series Dataframes/k20_EMA_5.5_Window_ts.RData")
###
load("Time Series Dataframes/k20_EMA_5.5_Window_ts.RData")
# Repeated measures with box− and violin plots
EMA_5.5_Window_ts$jit = jitter(EMA_5.5_Window_ts$Interval, amount = .09)
Pre_Post_Box_Violin = ggplot(data = EMA_5.5_Window_ts, aes(y = Mean)) +
geom_point(data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
alpha = .5) +
geom_point(data = EMA_5.5_Window_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
alpha = .5) +
geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
geom_half_boxplot(
data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.25),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
fill = "dodgerblue", alpha = .5) +
geom_half_boxplot(
data = EMA_5.5_Window_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .15),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
fill = "darkorange", alpha = .5) +
geom_half_violin(
data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = 1.3),
side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
geom_half_violin(
data = EMA_5.5_Window_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .3),
side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
xlab("Interval") + ylab("PHQ-9 Mean Score") +
#ggtitle("EMA Data (5+5 Timepoint Random Windows): Individual Pre-Post Means") +
#theme_classic() +
theme_bw() +
coord_cartesian(ylim = c(0, 24))
ggsave("Time Series Dataframes/k20_EMA_5.5_Window_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_EMA_5.5_Window_Pre_Post_Box_Violin.RData")
# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = EMA_5.5_Window_ts %>% filter(Interval == "1") %>% summarise(mean(Mean)) %>% as.numeric()
score_mean_2 = EMA_5.5_Window_ts %>% filter(Interval == "2") %>% summarise(mean(Mean)) %>% as.numeric()
score_median1 = EMA_5.5_Window_ts %>% filter(Interval == "1") %>% summarise(median(Mean)) %>% as.numeric()
score_median2 = EMA_5.5_Window_ts %>% filter(Interval == "2") %>% summarise(median(Mean)) %>% as.numeric()
score_sd_1 = EMA_5.5_Window_ts %>% filter(Interval == "1") %>% summarise(sd(Mean)) %>% as.numeric()
score_sd_2 = EMA_5.5_Window_ts %>% filter(Interval == "2") %>% summarise(sd(Mean)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(EMA_5.5_Window))
score_se_2 = score_sd_2/sqrt(nrow(EMA_5.5_Window))
score_ci_1 = EMA_5.5_Window_ts %>% filter(Interval == "1") %>% pull(Mean) %>% CI(., ci = 0.95)
score_ci_2 = EMA_5.5_Window_ts %>% filter(Interval == "2") %>% pull(Mean) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(EMA_5.5_Window), nrow(EMA_5.5_Window))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c(as.numeric(score_ci_1[1] - score_ci_1[3]), as.numeric(score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)
# EMA_5.5_Window_ts$jit = jitter(EMA_5.5_Window_ts$Interval, amount = .09) #already created above
x_tick_means = c(.87, 2.13)
Pre_Post_Box_Violin_Mean_CI = ggplot(data = EMA_5.5_Window_ts, aes(y = Mean)) +
geom_point(data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
alpha = .6) +
geom_point(data = EMA_5.5_Window_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
alpha = .6) +
geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
geom_half_boxplot(
data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.28),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
fill = "dodgerblue") +
geom_half_boxplot(
data = EMA_5.5_Window_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .18),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
fill = "darkorange") +
geom_half_violin(
data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.3),
side = "l", fill = "dodgerblue") +
geom_half_violin(
data = EMA_5.5_Window_ts %>% filter(Interval == "2"),aes(x = Interval, y = Mean), position = position_nudge(x = .3),
side = "r", fill = "darkorange") +
geom_point(data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1]),
position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
geom_errorbar(data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1],
ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
geom_point(data = EMA_5.5_Window_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2]),
position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
geom_errorbar(data = EMA_5.5_Window_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2],
ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]),
position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
xlab("Interval") + ylab("PHQ-9 Mean Score") +
#ggtitle("EMA Data (5+5 Timepoint Random Windows): Individual Pre-Post Means") +
#theme_classic() +
theme_bw() +
coord_cartesian(ylim = c(0, 24))
ggsave("Time Series Dataframes/k20_EMA_5.5_Window_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_EMA_5.5_Window_Pre_Post_Box_Violin_Mean_CI.RData")#knitr::include_graphics("Time Series Dataframes/k20_EMA_5.5_Window_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_EMA_5.5_Window_Pre-Post_Box_Violin_Mean+CI.jpg")EMA_5.5_Days %>%
within(., {ind.pretestSD = round(ind.pretestSD, digits = 2)
ind.posttestSD = round(ind.posttestSD, digits = 2)}) %>%
head() %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
scroll_box(width = "100%")| ID | Pre_MZP1 | Pre_MZP2 | Pre_MZP3 | Pre_MZP4 | Pre_MZP5 | Post_MZP1 | Post_MZP2 | Post_MZP3 | Post_MZP4 | Post_MZP5 | PRE1_1 | PRE1_2 | PRE1_3 | PRE1_4 | PRE1_5 | POST1_1 | POST1_2 | POST1_3 | POST1_4 | POST1_5 | PRE_Mean | POST_Mean | MeanDiff | ind.pretestSD | ind.posttestSD |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | PRE1_1 | PRE1_5 | PRE1_10 | PRE1_17 | PRE1_25 | POST1_4 | POST1_15 | POST1_17 | POST1_18 | POST1_26 | 9 | 17 | 8 | 8 | 7 | 6 | 3 | 4 | 4 | 3 | 9.8 | 4.0 | 5.8 | 4.09 | 1.22 |
| 2 | PRE1_4 | PRE1_5 | PRE1_7 | PRE1_24 | PRE1_25 | POST1_14 | POST1_15 | POST1_18 | POST1_20 | POST1_26 | 12 | 7 | 10 | 9 | 12 | 7 | 3 | 7 | 3 | 7 | 10.0 | 5.4 | 4.6 | 2.12 | 2.19 |
| 3 | PRE1_3 | PRE1_4 | PRE1_9 | PRE1_25 | PRE1_27 | POST1_2 | POST1_5 | POST1_13 | POST1_20 | POST1_30 | 5 | 7 | 7 | 11 | 10 | 7 | 14 | 15 | 9 | 13 | 8.0 | 11.6 | -3.6 | 2.45 | 3.44 |
| 4 | PRE1_1 | PRE1_3 | PRE1_8 | PRE1_26 | PRE1_28 | POST1_10 | POST1_11 | POST1_15 | POST1_22 | POST1_24 | 12 | 14 | 8 | 11 | 10 | 7 | 8 | 4 | 5 | 7 | 11.0 | 6.2 | 4.8 | 2.24 | 1.64 |
| 5 | PRE1_4 | PRE1_8 | PRE1_22 | PRE1_26 | PRE1_28 | POST1_4 | POST1_5 | POST1_13 | POST1_18 | POST1_28 | 8 | 12 | 11 | 7 | 13 | 13 | 8 | 5 | 1 | 2 | 10.2 | 5.8 | 4.4 | 2.59 | 4.87 |
| 6 | PRE1_2 | PRE1_3 | PRE1_18 | PRE1_24 | PRE1_29 | POST1_17 | POST1_18 | POST1_21 | POST1_23 | POST1_26 | 15 | 8 | 12 | 8 | 7 | 6 | 8 | 8 | 4 | 10 | 10.0 | 7.2 | 2.8 | 3.39 | 2.28 |
Pre-Post-Verläufe für 9 zufällig gezogene Personen
rand = sample(EMA_5.5_Days$ID, 9)
x = tibble(ID = c(rep(rand[1],times=11),
rep(rand[2],times=11),
rep(rand[3],times=11),
rep(rand[4],times=11),
rep(rand[5],times=11),
rep(rand[6],times=11),
rep(rand[7],times=11),
rep(rand[8],times=11),
rep(rand[9],times=11)),
MZP = rep(seq(as.Date("2020-01-01"), length.out=11, by="1 day"), times=9),
Score = c(as.numeric(EMA_5.5_Days[rand[1],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[1],post_5mzp]),
as.numeric(EMA_5.5_Days[rand[2],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[2],post_5mzp]),
as.numeric(EMA_5.5_Days[rand[3],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[3],post_5mzp]),
as.numeric(EMA_5.5_Days[rand[4],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[4],post_5mzp]),
as.numeric(EMA_5.5_Days[rand[5],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[5],post_5mzp]),
as.numeric(EMA_5.5_Days[rand[6],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[6],post_5mzp]),
as.numeric(EMA_5.5_Days[rand[7],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[7],post_5mzp]),
as.numeric(EMA_5.5_Days[rand[8],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[8],post_5mzp]),
as.numeric(EMA_5.5_Days[rand[9],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[9],post_5mzp])))
x %>%
group_by(ID) %>%
plot_time_series(MZP, Score,
#.color_var = ID, # for multiple lines in one plot
#.color_lab = "ID",
.facet_ncol = 3,
.facet_scales = "fixed",
.interactive = TRUE,
.facet_collapse = FALSE,
.smooth = TRUE,
.smooth_degree = 2,
.smooth_alpha = 0.5,
.smooth_size = 0.2
)# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R
# EMA_5.5_Days
# converting my dataframes to use in the same ggplot structure:
EMA_5.5_Days_ts = EMA_5.5_Days %>%
select(ID, PRE_Mean, POST_Mean) %>%
pivot_longer(!ID, names_to = "Interval", values_to = "Mean") %>%
mutate(ID = as.factor(ID),
Interval = rep(c(1,2), times = nrow(EMA_5.5_Days)))
save(EMA_5.5_Days_ts, file = "Time Series Dataframes/k20_EMA_5.5_Days_ts.RData")
###
load("Time Series Dataframes/k20_EMA_5.5_Days_ts.RData")
# Repeated measures with box− and violin plots
EMA_5.5_Days_ts$jit = jitter(EMA_5.5_Days_ts$Interval, amount = .09)
Pre_Post_Box_Violin = ggplot(data = EMA_5.5_Days_ts, aes(y = Mean)) +
geom_point(data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
alpha = .5) +
geom_point(data = EMA_5.5_Days_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
alpha = .5) +
geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
geom_half_boxplot(
data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.25),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
fill = "dodgerblue", alpha = .5) +
geom_half_boxplot(
data = EMA_5.5_Days_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .15),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
fill = "darkorange", alpha = .5) +
geom_half_violin(
data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = 1.3),
side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
geom_half_violin(
data = EMA_5.5_Days_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .3),
side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
xlab("Interval") + ylab("PHQ-9 Mean Score") +
#ggtitle("EMA Data (5+5 Timepoint Random Days): Individual Pre-Post Means") +
#theme_classic() +
theme_bw() +
coord_cartesian(ylim = c(0, 24))
ggsave("Time Series Dataframes/k20_EMA_5.5_Days_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_EMA_5.5_Days_Pre_Post_Box_Violin.RData")
# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = EMA_5.5_Days_ts %>% filter(Interval == "1") %>% summarise(mean(Mean)) %>% as.numeric()
score_mean_2 = EMA_5.5_Days_ts %>% filter(Interval == "2") %>% summarise(mean(Mean)) %>% as.numeric()
score_median1 = EMA_5.5_Days_ts %>% filter(Interval == "1") %>% summarise(median(Mean)) %>% as.numeric()
score_median2 = EMA_5.5_Days_ts %>% filter(Interval == "2") %>% summarise(median(Mean)) %>% as.numeric()
score_sd_1 = EMA_5.5_Days_ts %>% filter(Interval == "1") %>% summarise(sd(Mean)) %>% as.numeric()
score_sd_2 = EMA_5.5_Days_ts %>% filter(Interval == "2") %>% summarise(sd(Mean)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(EMA_5.5_Days))
score_se_2 = score_sd_2/sqrt(nrow(EMA_5.5_Days))
score_ci_1 = EMA_5.5_Days_ts %>% filter(Interval == "1") %>% pull(Mean) %>% CI(., ci = 0.95)
score_ci_2 = EMA_5.5_Days_ts %>% filter(Interval == "2") %>% pull(Mean) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(EMA_5.5_Days), nrow(EMA_5.5_Days))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c(as.numeric(score_ci_1[1] - score_ci_1[3]), as.numeric(score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)
# EMA_5.5_Days_ts$jit = jitter(EMA_5.5_Days_ts$Interval, amount = .09) #already created above
x_tick_means = c(.87, 2.13)
Pre_Post_Box_Violin_Mean_CI = ggplot(data = EMA_5.5_Days_ts, aes(y = Mean)) +
geom_point(data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
alpha = .6) +
geom_point(data = EMA_5.5_Days_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
alpha = .6) +
geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
geom_half_boxplot(
data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.28),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
fill = "dodgerblue") +
geom_half_boxplot(
data = EMA_5.5_Days_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .18),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
fill = "darkorange") +
geom_half_violin(
data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.3),
side = "l", fill = "dodgerblue") +
geom_half_violin(
data = EMA_5.5_Days_ts %>% filter(Interval == "2"),aes(x = Interval, y = Mean), position = position_nudge(x = .3),
side = "r", fill = "darkorange") +
geom_point(data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1]),
position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
geom_errorbar(data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1],
ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
geom_point(data = EMA_5.5_Days_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2]),
position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
geom_errorbar(data = EMA_5.5_Days_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2],
ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]),
position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
xlab("Interval") + ylab("PHQ-9 Mean Score") +
#ggtitle("EMA Data (5+5 Timepoint Random Days): Individual Pre-Post Means") +
#theme_classic() +
theme_bw() +
coord_cartesian(ylim = c(0, 24))
ggsave("Time Series Dataframes/k20_EMA_5.5_Days_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_EMA_5.5_Days_Pre_Post_Box_Violin_Mean_CI.RData")#knitr::include_graphics("Time Series Dataframes/k20_EMA_5.5_Days_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_EMA_5.5_Days_Pre-Post_Box_Violin_Mean+CI.jpg")tibble(Descriptives = c("mean_PRE_Mean","mean_POST_Mean","mean_MeanDiff","mean_ind.pretestSD","mean_ind.posttestSD"),
EMA_5.5 = round(c(mean(EMA_5.5$PRE_Mean),mean(EMA_5.5$POST_Mean),mean(EMA_5.5$MeanDiff),
mean(EMA_5.5$ind.pretestSD),mean(EMA_5.5$ind.posttestSD)), digits = 3),
EMA_30.30 = round(c(mean(EMA_30.30$PRE_Mean),mean(EMA_30.30$POST_Mean),mean(EMA_30.30$MeanDiff),
mean(EMA_30.30$ind.pretestSD),mean(EMA_30.30$ind.posttestSD)), digits = 3),
EMA_5.5_Window = round(c(mean(EMA_5.5_Window$PRE_Mean),mean(EMA_5.5_Window$POST_Mean),
mean(EMA_5.5_Window$MeanDiff),mean(EMA_5.5_Window$ind.pretestSD),
mean(EMA_5.5_Window$ind.posttestSD)), digits = 3),
EMA_5.5_Days = round(c(mean(EMA_5.5_Days$PRE_Mean),mean(EMA_5.5_Days$POST_Mean),mean(EMA_5.5_Days$MeanDiff),
mean(EMA_5.5_Days$ind.pretestSD),mean(EMA_5.5_Days$ind.posttestSD)), digits = 3)) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Descriptives | EMA_5.5 | EMA_30.30 | EMA_5.5_Window | EMA_5.5_Days |
|---|---|---|---|---|
| mean_PRE_Mean | 10.307 | 10.307 | 10.320 | 10.314 |
| mean_POST_Mean | 7.116 | 7.116 | 7.098 | 7.113 |
| mean_MeanDiff | 3.191 | 3.191 | 3.222 | 3.200 |
| mean_ind.pretestSD | 2.756 | 2.508 | 2.579 | 2.417 |
| mean_ind.posttestSD | 3.425 | 3.115 | 3.182 | 2.982 |
Boxplots der Pre- und Post-Mittelwerte
# ein Boxplot mit Pre- und Post-Verteilungen
#temp = tibble(Scores = c(EMA_5.5$PRE_Mean, EMA_5.5$POST_Mean, EMA_30.30$PRE_Mean, EMA_30.30$POST_Mean,
# EMA_5.5_Window$PRE_Mean, EMA_5.5_Window$POST_Mean, EMA_5.5_Days$PRE_Mean, EMA_5.5_Days$POST_Mean),
# Datasets = rep(as_factor(c("EMA_5.5", "EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days")), each = 2*length(EMA_5.5$PRE_Mean)),
# Assessment = rep(as_factor(c("PRE", "POST", "PRE", "POST", "PRE", "POST", "PRE", "POST")), each = length(EMA_5.5$PRE_Mean)))#<<
temp = tibble(Scores = c(EMA_30.30$PRE_Mean, EMA_30.30$POST_Mean, EMA_5.5_Window$PRE_Mean, EMA_5.5_Window$POST_Mean,
EMA_5.5_Days$PRE_Mean, EMA_5.5_Days$POST_Mean),
Datasets = rep(as_factor(c("EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days")), each = 2*length(EMA_30.30$PRE_Mean)),
Assessment = rep(as_factor(c("PRE", "POST", "PRE", "POST", "PRE", "POST")), each = length(EMA_30.30$PRE_Mean)))#<<
ggplot(temp, aes(x = Datasets, y = Scores, fill = Assessment)) +
geom_boxplot() +
ylim(0, 27) +
xlab("Dataset") +
ylab("PHQ-9 Interval Means")#<<#ggsave("Plots/k20_EMA-Datasets_Pre-Post_Boxplots_mit_EMA_5.5.jpg", width = 6, height = 4)#<<
#ggsave("Plots/k20_EMA-Datasets_Pre-Post_Boxplots.jpg", width = 6, height = 4)#<<Prozentuale Überlappung der Pre-Mittelwerte
# Overlap-Plots zum Vergleich
final.plot(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_30.30_PRE_Mean = EMA_30.30$PRE_Mean),
overlap(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_30.30_PRE_Mean = EMA_30.30$PRE_Mean))$OV)
final.plot(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_5.5_Window_PRE_Mean = EMA_5.5_Window$PRE_Mean),
overlap(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_5.5_Window_PRE_Mean =
EMA_5.5_Window$PRE_Mean))$OV)
final.plot(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_5.5_Days_PRE_Mean = EMA_5.5_Days$PRE_Mean),
overlap(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_5.5_Days_PRE_Mean =
EMA_5.5_Days$PRE_Mean))$OV)Prozentuale Überlappung der Post-Mittelwerte
# Overlap-Plots zum Vergleich
final.plot(list(EMA_5.5_POST_Mean = EMA_5.5$POST_Mean, EMA_30MZP_POST_Mean = EMA_30.30$POST_Mean),
overlap(list(EMA_5.5_POST_Mean = EMA_5.5$POST_Mean, EMA_30MZP_POST_Mean =
EMA_30.30$POST_Mean))$OV)
final.plot(list(EMA_5.5_POST_Mean = EMA_5.5$POST_Mean, EMA_Window_POST_Mean = EMA_5.5_Window$POST_Mean),
overlap(list(EMA_5.5_POST_Mean = EMA_5.5$POST_Mean, EMA_Window_POST_Mean =
EMA_5.5_Window$POST_Mean))$OV)
final.plot(list(EMA_5.5_POST_Mean = EMA_5.5$POST_Mean, EMA_Days_POST_Mean = EMA_5.5_Days$POST_Mean),
overlap(list(EMA_5.5_POST_Mean = EMA_5.5$POST_Mean, EMA_Days_POST_Mean = EMA_5.5_Days$POST_Mean))$OV)# Korrelationsmatrix von PRE- und POST-MZP:
EMA_5.5_KorMat = cor(EMA_5.5[, c(pre_5mzp, post_5mzp)]) %>%
round(., digits = 2)
# durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden MZP (beachte: ohne Fisher-Z-Transformation):
pre_inter_item_rtt = 0L
for (i in 1:4) {
pre_inter_item_rtt = pre_inter_item_rtt + FisherZ(EMA_5.5_KorMat[i,i+1])
}
pre_inter_item_rtt = FisherZInv(pre_inter_item_rtt / 4)
post_inter_item_rtt = 0L
for (i in 5:9) {
post_inter_item_rtt = post_inter_item_rtt + FisherZ(EMA_5.5_KorMat[i,i+1])
}
post_inter_item_rtt = FisherZInv(post_inter_item_rtt / 4)
for (i in 1:9) {
EMA_5.5_KorMat[i, i+1] = cell_spec(EMA_5.5_KorMat[i, i+1], "html", bold = TRUE)
}
rownames(EMA_5.5_KorMat) = cell_spec(rownames(EMA_5.5_KorMat), "html", bold = TRUE)
EMA_5.5_KorMat %>%
kable(., format = "html", escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, fixed_thead = T)| PRE1_1 | PRE1_2 | PRE1_3 | PRE1_4 | PRE1_5 | POST1_1 | POST1_2 | POST1_3 | POST1_4 | POST1_5 | |
|---|---|---|---|---|---|---|---|---|---|---|
| PRE1_1 | 1 | 0.32 | 0.1 | 0.04 | 0.02 | 0.16 | 0.05 | 0.02 | 0.01 | 0.01 |
| PRE1_2 | 0.32 | 1 | 0.32 | 0.12 | 0.05 | 0.05 | 0.01 | 0 | 0 | 0 |
| PRE1_3 | 0.1 | 0.32 | 1 | 0.32 | 0.12 | 0 | 0 | 0.01 | 0.01 | 0 |
| PRE1_4 | 0.04 | 0.12 | 0.32 | 1 | 0.32 | 0.01 | 0 | 0.02 | 0.01 | 0.02 |
| PRE1_5 | 0.02 | 0.05 | 0.12 | 0.32 | 1 | 0 | -0.01 | 0.01 | 0 | 0.02 |
| POST1_1 | 0.16 | 0.05 | 0 | 0.01 | 0 | 1 | 0.32 | 0.1 | 0.04 | 0.01 |
| POST1_2 | 0.05 | 0.01 | 0 | 0 | -0.01 | 0.32 | 1 | 0.31 | 0.12 | 0.03 |
| POST1_3 | 0.02 | 0 | 0.01 | 0.02 | 0.01 | 0.1 | 0.31 | 1 | 0.32 | 0.11 |
| POST1_4 | 0.01 | 0 | 0.01 | 0.01 | 0 | 0.04 | 0.12 | 0.32 | 1 | 0.32 |
| POST1_5 | 0.01 | 0 | 0 | 0.02 | 0.02 | 0.01 | 0.03 | 0.11 | 0.32 | 1 |
# mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP:
PRE_alpha = CronbachAlpha(EMA_5.5[pre_5mzp])
POST_alpha = CronbachAlpha(EMA_5.5[post_5mzp])
EMA_5.5_Alpha = FisherZInv(mean(c(FisherZ(PRE_alpha), FisherZ(POST_alpha))))Korrelation zwischen den Pre- und Post-Intervall-Mittelwerten = 0.047.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Pre-MZP (Fisher-Z-transformiert): r = 0.32.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Post-MZP (Fisher-Z-transformiert): r = 0.32.
Mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP = 0.509.
# Korrelationsmatrix von PRE- und POST-MZP:
EMA_30.30_KorMat = cor(EMA_30.30[, c(pre_30mzp, post_30mzp)]) %>%
round(., digits = 2)
# durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden MZP (beachte: ohne Fisher-Z-Transformation):
pre_inter_item_rtt = 0L
for (i in 1:29) {
pre_inter_item_rtt = pre_inter_item_rtt + FisherZ(EMA_30.30_KorMat[i,i+1])
}
pre_inter_item_rtt = FisherZInv(pre_inter_item_rtt / 29)
post_inter_item_rtt = 0L
for (i in 31:59) {
post_inter_item_rtt = post_inter_item_rtt + FisherZ(EMA_30.30_KorMat[i,i+1])
}
post_inter_item_rtt = FisherZInv(post_inter_item_rtt / 29)
for (i in 1:59) {
EMA_30.30_KorMat[i, i+1] = cell_spec(EMA_30.30_KorMat[i, i+1], "html", bold = TRUE)
}
rownames(EMA_30.30_KorMat) = cell_spec(rownames(EMA_30.30_KorMat), "html", bold = TRUE)
EMA_30.30_KorMat %>%
kable(., format = "html", escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, fixed_thead = T) %>%
scroll_box(height = "800px")| PRE1_1 | PRE1_2 | PRE1_3 | PRE1_4 | PRE1_5 | PRE1_6 | PRE1_7 | PRE1_8 | PRE1_9 | PRE1_10 | PRE1_11 | PRE1_12 | PRE1_13 | PRE1_14 | PRE1_15 | PRE1_16 | PRE1_17 | PRE1_18 | PRE1_19 | PRE1_20 | PRE1_21 | PRE1_22 | PRE1_23 | PRE1_24 | PRE1_25 | PRE1_26 | PRE1_27 | PRE1_28 | PRE1_29 | PRE1_30 | POST1_1 | POST1_2 | POST1_3 | POST1_4 | POST1_5 | POST1_6 | POST1_7 | POST1_8 | POST1_9 | POST1_10 | POST1_11 | POST1_12 | POST1_13 | POST1_14 | POST1_15 | POST1_16 | POST1_17 | POST1_18 | POST1_19 | POST1_20 | POST1_21 | POST1_22 | POST1_23 | POST1_24 | POST1_25 | POST1_26 | POST1_27 | POST1_28 | POST1_29 | POST1_30 | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| PRE1_1 | 1 | 0.32 | 0.1 | 0.04 | 0.02 | 0.27 | 0.32 | 0.32 | 0.3 | 0.27 | 0.27 | 0.3 | 0.33 | 0.32 | 0.26 | 0.25 | 0.33 | 0.33 | 0.32 | 0.24 | 0.28 | 0.31 | 0.31 | 0.32 | 0.26 | 0.26 | 0.3 | 0.32 | 0.32 | 0.27 | 0.16 | 0.05 | 0.02 | 0.01 | 0.01 | 0.05 | 0.05 | 0.05 | 0.06 | 0.04 | 0.05 | 0.06 | 0.05 | 0.04 | 0.03 | 0.05 | 0.06 | 0.04 | 0.06 | 0.03 | 0.04 | 0.05 | 0.05 | 0.06 | 0.04 | 0.05 | 0.06 | 0.05 | 0.04 | 0.04 |
| PRE1_2 | 0.32 | 1 | 0.32 | 0.12 | 0.05 | 0.33 | 0.38 | 0.39 | 0.38 | 0.33 | 0.33 | 0.39 | 0.39 | 0.39 | 0.31 | 0.33 | 0.4 | 0.42 | 0.39 | 0.29 | 0.33 | 0.4 | 0.39 | 0.38 | 0.32 | 0.33 | 0.38 | 0.39 | 0.37 | 0.33 | 0.05 | 0.01 | 0 | 0 | 0 | 0.03 | 0 | 0.01 | 0.01 | 0 | 0.02 | 0.01 | 0.01 | 0.01 | 0.01 | 0.01 | 0.02 | 0 | 0.02 | 0.02 | 0 | 0.01 | 0.01 | 0.01 | 0.02 | 0 | 0.02 | 0.03 | 0 | 0.01 |
| PRE1_3 | 0.1 | 0.32 | 1 | 0.32 | 0.12 | 0.34 | 0.39 | 0.42 | 0.4 | 0.32 | 0.34 | 0.41 | 0.41 | 0.41 | 0.3 | 0.34 | 0.42 | 0.41 | 0.39 | 0.31 | 0.33 | 0.43 | 0.43 | 0.39 | 0.3 | 0.33 | 0.4 | 0.43 | 0.39 | 0.33 | 0 | 0 | 0.01 | 0.01 | 0 | 0.01 | 0.01 | 0.01 | -0.01 | 0 | 0 | 0 | 0.02 | 0 | 0.01 | 0.01 | 0.01 | -0.01 | 0 | 0.01 | 0 | 0.02 | -0.01 | 0 | 0 | 0.02 | 0 | 0.01 | 0 | 0 |
| PRE1_4 | 0.04 | 0.12 | 0.32 | 1 | 0.32 | 0.32 | 0.39 | 0.41 | 0.38 | 0.32 | 0.34 | 0.39 | 0.41 | 0.37 | 0.3 | 0.32 | 0.38 | 0.39 | 0.4 | 0.33 | 0.3 | 0.4 | 0.41 | 0.4 | 0.3 | 0.3 | 0.37 | 0.42 | 0.39 | 0.34 | 0.01 | 0 | 0.02 | 0.01 | 0.02 | 0 | 0.02 | 0.02 | 0.01 | 0.01 | 0 | 0.02 | 0.02 | 0 | 0.01 | 0.02 | 0.03 | 0 | 0 | 0 | 0.01 | 0.01 | 0.01 | 0 | 0.01 | 0 | 0.02 | 0.03 | 0 | 0 |
| PRE1_5 | 0.02 | 0.05 | 0.12 | 0.32 | 1 | 0.27 | 0.33 | 0.34 | 0.33 | 0.25 | 0.28 | 0.33 | 0.33 | 0.32 | 0.26 | 0.27 | 0.31 | 0.31 | 0.33 | 0.3 | 0.26 | 0.35 | 0.32 | 0.32 | 0.26 | 0.28 | 0.33 | 0.34 | 0.31 | 0.26 | 0 | -0.01 | 0.01 | 0 | 0.02 | -0.01 | 0.02 | 0 | 0.01 | 0 | 0 | 0 | 0 | 0.02 | 0 | 0 | 0.01 | 0.01 | 0.01 | 0 | 0.01 | 0.01 | 0.02 | 0 | -0.02 | 0.01 | 0.01 | 0.01 | 0 | -0.01 |
| PRE1_6 | 0.27 | 0.33 | 0.34 | 0.32 | 0.27 | 1 | 0.32 | 0.12 | 0.06 | 0.03 | 0.28 | 0.36 | 0.34 | 0.31 | 0.25 | 0.31 | 0.29 | 0.32 | 0.34 | 0.27 | 0.27 | 0.33 | 0.33 | 0.34 | 0.26 | 0.29 | 0.31 | 0.3 | 0.32 | 0.31 | 0.04 | 0.02 | 0 | 0 | 0.01 | 0 | 0.01 | 0.02 | 0.02 | 0.02 | 0.02 | 0.02 | 0.02 | 0.01 | 0.01 | 0.01 | 0.02 | 0.01 | 0.02 | 0.02 | 0.01 | 0.01 | 0.03 | 0.01 | 0.02 | 0.02 | 0.02 | 0.02 | 0.01 | 0 |
| PRE1_7 | 0.32 | 0.38 | 0.39 | 0.39 | 0.33 | 0.32 | 1 | 0.33 | 0.1 | 0.06 | 0.33 | 0.38 | 0.39 | 0.41 | 0.3 | 0.37 | 0.39 | 0.36 | 0.39 | 0.3 | 0.32 | 0.4 | 0.42 | 0.41 | 0.28 | 0.3 | 0.4 | 0.42 | 0.38 | 0.31 | 0.04 | 0.01 | 0.01 | 0.02 | 0.01 | 0.03 | 0.03 | 0.02 | 0 | 0.01 | 0.02 | 0.02 | 0.03 | 0.01 | 0.02 | 0.02 | 0.03 | 0.01 | 0.01 | 0.01 | 0.02 | 0.01 | 0.01 | 0.01 | 0.03 | 0.01 | 0.02 | 0.03 | 0.01 | 0.01 |
| PRE1_8 | 0.32 | 0.39 | 0.42 | 0.41 | 0.34 | 0.12 | 0.33 | 1 | 0.33 | 0.09 | 0.36 | 0.42 | 0.43 | 0.39 | 0.29 | 0.32 | 0.43 | 0.43 | 0.39 | 0.32 | 0.32 | 0.44 | 0.42 | 0.4 | 0.31 | 0.28 | 0.4 | 0.47 | 0.4 | 0.33 | 0.05 | 0.01 | 0.02 | 0 | 0 | 0.03 | 0.01 | 0.01 | 0.02 | 0.01 | 0.01 | 0 | 0.02 | 0.02 | 0.02 | 0.02 | 0.02 | 0.01 | 0.02 | 0.01 | 0.02 | 0.01 | 0.02 | 0.01 | 0.01 | 0.02 | 0.01 | 0.02 | 0.02 | 0.01 |
| PRE1_9 | 0.3 | 0.38 | 0.4 | 0.38 | 0.33 | 0.06 | 0.1 | 0.33 | 1 | 0.32 | 0.33 | 0.36 | 0.4 | 0.39 | 0.31 | 0.29 | 0.39 | 0.39 | 0.38 | 0.34 | 0.31 | 0.4 | 0.39 | 0.37 | 0.33 | 0.33 | 0.39 | 0.39 | 0.39 | 0.3 | 0.06 | 0.01 | 0.03 | 0.01 | 0.01 | 0.02 | 0.02 | 0.03 | 0.03 | 0 | 0.02 | 0.03 | 0.03 | 0.02 | 0.01 | 0.03 | 0.03 | 0.02 | 0.02 | 0.02 | 0.02 | 0.03 | 0.02 | 0.03 | 0.01 | 0.02 | 0.02 | 0.04 | 0.01 | 0.03 |
| PRE1_10 | 0.27 | 0.33 | 0.32 | 0.32 | 0.25 | 0.03 | 0.06 | 0.09 | 0.32 | 1 | 0.26 | 0.31 | 0.3 | 0.33 | 0.29 | 0.22 | 0.33 | 0.36 | 0.33 | 0.24 | 0.29 | 0.32 | 0.3 | 0.3 | 0.27 | 0.3 | 0.27 | 0.32 | 0.31 | 0.29 | 0.03 | 0 | 0.01 | 0.01 | 0.01 | 0 | 0.02 | 0.01 | 0.01 | 0.01 | 0 | 0.03 | 0.01 | 0.01 | 0 | 0.01 | 0.02 | 0 | 0.01 | 0.01 | -0.01 | 0.03 | 0.01 | 0.02 | 0 | 0.01 | 0.02 | 0.02 | -0.01 | 0 |
| PRE1_11 | 0.27 | 0.33 | 0.34 | 0.34 | 0.28 | 0.28 | 0.33 | 0.36 | 0.33 | 0.26 | 1 | 0.37 | 0.13 | 0.07 | 0.01 | 0.3 | 0.33 | 0.34 | 0.35 | 0.24 | 0.29 | 0.35 | 0.35 | 0.34 | 0.24 | 0.28 | 0.34 | 0.31 | 0.36 | 0.27 | 0.04 | 0.01 | 0.02 | 0.01 | 0.03 | 0.03 | 0.02 | 0.03 | 0.01 | 0.01 | 0.02 | 0.03 | 0.03 | 0.02 | 0.01 | 0.02 | 0.02 | 0.01 | 0.02 | 0.03 | 0.02 | 0.03 | 0.01 | 0.03 | 0.02 | 0.01 | 0.02 | 0.04 | 0.02 | 0.01 |
| PRE1_12 | 0.3 | 0.39 | 0.41 | 0.39 | 0.33 | 0.36 | 0.38 | 0.42 | 0.36 | 0.31 | 0.37 | 1 | 0.3 | 0.11 | 0.03 | 0.35 | 0.41 | 0.41 | 0.36 | 0.3 | 0.33 | 0.4 | 0.4 | 0.4 | 0.29 | 0.34 | 0.39 | 0.41 | 0.38 | 0.31 | 0.06 | 0.01 | 0 | 0.02 | 0 | 0.02 | 0.03 | 0.02 | 0 | 0.02 | 0.03 | 0.02 | 0.02 | 0 | 0.01 | 0.02 | 0.02 | 0 | 0.02 | 0.03 | 0.01 | 0.02 | 0.02 | 0.03 | 0.01 | 0.01 | 0.03 | 0.03 | 0 | 0.01 |
| PRE1_13 | 0.33 | 0.39 | 0.41 | 0.41 | 0.33 | 0.34 | 0.39 | 0.43 | 0.4 | 0.3 | 0.13 | 0.3 | 1 | 0.33 | 0.1 | 0.3 | 0.41 | 0.41 | 0.41 | 0.34 | 0.33 | 0.4 | 0.38 | 0.41 | 0.33 | 0.34 | 0.37 | 0.43 | 0.41 | 0.32 | 0.03 | 0.01 | 0.01 | 0.01 | 0.01 | 0 | 0 | 0.02 | 0.03 | 0.01 | 0.03 | 0.01 | 0.01 | 0.01 | 0 | 0.03 | 0.03 | 0.01 | 0 | 0 | 0.01 | 0.02 | 0.02 | 0 | 0.01 | 0.02 | 0.02 | 0.01 | 0.01 | 0 |
| PRE1_14 | 0.32 | 0.39 | 0.41 | 0.37 | 0.32 | 0.31 | 0.41 | 0.39 | 0.39 | 0.33 | 0.07 | 0.11 | 0.33 | 1 | 0.3 | 0.31 | 0.39 | 0.41 | 0.38 | 0.32 | 0.29 | 0.42 | 0.43 | 0.39 | 0.29 | 0.32 | 0.38 | 0.43 | 0.37 | 0.32 | 0.06 | 0.02 | 0 | 0 | 0.01 | 0.02 | 0.02 | 0.01 | 0.02 | 0.01 | 0.01 | 0.01 | 0.03 | 0.02 | 0.02 | 0.01 | 0.03 | 0.02 | 0.02 | 0 | 0.01 | 0.01 | 0.02 | 0.02 | 0.03 | 0.02 | 0.01 | 0.02 | 0.01 | 0.03 |
| PRE1_15 | 0.26 | 0.31 | 0.3 | 0.3 | 0.26 | 0.25 | 0.3 | 0.29 | 0.31 | 0.29 | 0.01 | 0.03 | 0.1 | 0.3 | 1 | 0.25 | 0.29 | 0.29 | 0.34 | 0.27 | 0.26 | 0.32 | 0.3 | 0.27 | 0.29 | 0.22 | 0.29 | 0.32 | 0.27 | 0.33 | 0.03 | 0 | 0.03 | -0.01 | 0 | 0.01 | 0.02 | 0.01 | 0.02 | 0 | -0.01 | 0.02 | 0.02 | 0.02 | 0.01 | 0 | 0.02 | 0 | 0.02 | 0 | 0.01 | 0.02 | 0.02 | 0 | 0 | 0.01 | 0.01 | 0.03 | 0.01 | 0 |
| PRE1_16 | 0.25 | 0.33 | 0.34 | 0.32 | 0.27 | 0.31 | 0.37 | 0.32 | 0.29 | 0.22 | 0.3 | 0.35 | 0.3 | 0.31 | 0.25 | 1 | 0.31 | 0.11 | 0.07 | 0.03 | 0.24 | 0.32 | 0.34 | 0.34 | 0.27 | 0.26 | 0.31 | 0.35 | 0.29 | 0.3 | 0.03 | 0 | 0 | 0.01 | 0 | 0 | 0.01 | 0.01 | 0.01 | 0.01 | 0.02 | 0.02 | 0.02 | 0.01 | -0.01 | 0 | 0.01 | 0.01 | 0.02 | 0.01 | 0.01 | 0.01 | 0 | 0.03 | 0.01 | 0.01 | 0.02 | 0.02 | 0 | 0 |
| PRE1_17 | 0.33 | 0.4 | 0.42 | 0.38 | 0.31 | 0.29 | 0.39 | 0.43 | 0.39 | 0.33 | 0.33 | 0.41 | 0.41 | 0.39 | 0.29 | 0.31 | 1 | 0.36 | 0.13 | 0.04 | 0.3 | 0.4 | 0.44 | 0.37 | 0.32 | 0.34 | 0.38 | 0.42 | 0.41 | 0.28 | 0.07 | 0.01 | 0.01 | 0.02 | 0 | 0.02 | 0.03 | 0.02 | 0.01 | 0.02 | 0.01 | 0.03 | 0.03 | 0.03 | 0.01 | 0.03 | 0.03 | 0.01 | 0.01 | 0.03 | 0.01 | 0.01 | 0.04 | 0.02 | 0.02 | 0.02 | 0.02 | 0.04 | 0.01 | 0.01 |
| PRE1_18 | 0.33 | 0.42 | 0.41 | 0.39 | 0.31 | 0.32 | 0.36 | 0.43 | 0.39 | 0.36 | 0.34 | 0.41 | 0.41 | 0.41 | 0.29 | 0.11 | 0.36 | 1 | 0.31 | 0.08 | 0.35 | 0.41 | 0.4 | 0.41 | 0.29 | 0.36 | 0.39 | 0.38 | 0.38 | 0.35 | 0.06 | 0.03 | 0.01 | -0.01 | 0 | 0.03 | 0.03 | 0.01 | 0.02 | 0.01 | 0.01 | 0.02 | 0.03 | 0.02 | 0.01 | 0.02 | 0.02 | 0.01 | 0.02 | 0.02 | 0.01 | 0.03 | 0.01 | 0.02 | 0.01 | 0.01 | 0.01 | 0.04 | 0.01 | 0.01 |
| PRE1_19 | 0.32 | 0.39 | 0.39 | 0.4 | 0.33 | 0.34 | 0.39 | 0.39 | 0.38 | 0.33 | 0.35 | 0.36 | 0.41 | 0.38 | 0.34 | 0.07 | 0.13 | 0.31 | 1 | 0.33 | 0.35 | 0.43 | 0.39 | 0.37 | 0.3 | 0.3 | 0.38 | 0.42 | 0.4 | 0.35 | 0.03 | 0 | 0.02 | 0.01 | 0.03 | 0.03 | 0.01 | 0.03 | 0.01 | 0 | 0.01 | 0.01 | 0.02 | 0.02 | 0.03 | 0.02 | 0.03 | 0.01 | 0.03 | 0.01 | 0.01 | 0.03 | 0.02 | 0.01 | 0.02 | 0.02 | 0.03 | 0.03 | 0.01 | 0.01 |
| PRE1_20 | 0.24 | 0.29 | 0.31 | 0.33 | 0.3 | 0.27 | 0.3 | 0.32 | 0.34 | 0.24 | 0.24 | 0.3 | 0.34 | 0.32 | 0.27 | 0.03 | 0.04 | 0.08 | 0.33 | 1 | 0.27 | 0.33 | 0.29 | 0.33 | 0.25 | 0.24 | 0.32 | 0.34 | 0.31 | 0.27 | 0.02 | 0.01 | 0.03 | 0 | 0.01 | 0 | 0.01 | 0.03 | 0.02 | 0 | 0.02 | 0.01 | 0.01 | 0.01 | 0.02 | 0.02 | 0.03 | 0 | 0.01 | 0 | 0.02 | 0.02 | 0.02 | -0.01 | 0.01 | 0.02 | 0.01 | 0.01 | 0.01 | 0.01 |
| PRE1_21 | 0.28 | 0.33 | 0.33 | 0.3 | 0.26 | 0.27 | 0.32 | 0.32 | 0.31 | 0.29 | 0.29 | 0.33 | 0.33 | 0.29 | 0.26 | 0.24 | 0.3 | 0.35 | 0.35 | 0.27 | 1 | 0.33 | 0.1 | 0.07 | 0.01 | 0.27 | 0.33 | 0.3 | 0.34 | 0.27 | 0.04 | 0.02 | 0.01 | 0.01 | 0 | 0.01 | 0.01 | 0.01 | 0.03 | 0.01 | 0.03 | 0.02 | 0.01 | 0.01 | 0.01 | 0.02 | 0.01 | 0.01 | 0.01 | 0.03 | 0.01 | 0.03 | 0.03 | 0.01 | 0 | 0.02 | 0.02 | 0.01 | 0.01 | 0.01 |
| PRE1_22 | 0.31 | 0.4 | 0.43 | 0.4 | 0.35 | 0.33 | 0.4 | 0.44 | 0.4 | 0.32 | 0.35 | 0.4 | 0.4 | 0.42 | 0.32 | 0.32 | 0.4 | 0.41 | 0.43 | 0.33 | 0.33 | 1 | 0.37 | 0.15 | 0.05 | 0.34 | 0.39 | 0.43 | 0.39 | 0.34 | 0.04 | 0.01 | 0.01 | -0.02 | 0 | 0.02 | 0.02 | 0.02 | 0 | -0.01 | 0 | 0 | 0.01 | 0.01 | 0.02 | 0 | 0.03 | -0.01 | 0.01 | 0.02 | 0.02 | 0.01 | 0.01 | 0.01 | -0.01 | 0.01 | -0.01 | 0.04 | 0 | 0.01 |
| PRE1_23 | 0.31 | 0.39 | 0.43 | 0.41 | 0.32 | 0.33 | 0.42 | 0.42 | 0.39 | 0.3 | 0.35 | 0.4 | 0.38 | 0.43 | 0.3 | 0.34 | 0.44 | 0.4 | 0.39 | 0.29 | 0.1 | 0.37 | 1 | 0.31 | 0.08 | 0.31 | 0.36 | 0.43 | 0.43 | 0.33 | 0.05 | 0.01 | 0.01 | 0 | 0.01 | 0.03 | 0.01 | 0.02 | 0.02 | 0.01 | 0.02 | 0.02 | 0.02 | 0.02 | 0.01 | 0.02 | 0.04 | 0.02 | 0.01 | 0 | 0.01 | 0.02 | 0 | 0.03 | 0.02 | 0.01 | 0.02 | 0.03 | 0.01 | 0 |
| PRE1_24 | 0.32 | 0.38 | 0.39 | 0.4 | 0.32 | 0.34 | 0.41 | 0.4 | 0.37 | 0.3 | 0.34 | 0.4 | 0.41 | 0.39 | 0.27 | 0.34 | 0.37 | 0.41 | 0.37 | 0.33 | 0.07 | 0.15 | 0.31 | 1 | 0.29 | 0.31 | 0.36 | 0.45 | 0.35 | 0.34 | 0.04 | 0.01 | 0.01 | 0.02 | 0.01 | 0.01 | 0.02 | 0.02 | 0.02 | 0.02 | 0.01 | 0.03 | 0.04 | 0.02 | -0.01 | 0.03 | 0.03 | 0.02 | 0.01 | 0 | 0.01 | 0.02 | 0.01 | 0.02 | 0.03 | 0 | 0.03 | 0.03 | 0.02 | 0.01 |
| PRE1_25 | 0.26 | 0.32 | 0.3 | 0.3 | 0.26 | 0.26 | 0.28 | 0.31 | 0.33 | 0.27 | 0.24 | 0.29 | 0.33 | 0.29 | 0.29 | 0.27 | 0.32 | 0.29 | 0.3 | 0.25 | 0.01 | 0.05 | 0.08 | 0.29 | 1 | 0.27 | 0.32 | 0.31 | 0.27 | 0.27 | 0.03 | -0.01 | 0.03 | 0.02 | 0.02 | 0.01 | 0.03 | 0.03 | 0.02 | 0.01 | 0.01 | 0.03 | 0.03 | 0.01 | 0.02 | 0.01 | 0.02 | 0.01 | 0.04 | 0.02 | 0 | 0.02 | 0.03 | 0.01 | 0.03 | 0.03 | 0.03 | 0.02 | 0 | 0.02 |
| PRE1_26 | 0.26 | 0.33 | 0.33 | 0.3 | 0.28 | 0.29 | 0.3 | 0.28 | 0.33 | 0.3 | 0.28 | 0.34 | 0.34 | 0.32 | 0.22 | 0.26 | 0.34 | 0.36 | 0.3 | 0.24 | 0.27 | 0.34 | 0.31 | 0.31 | 0.27 | 1 | 0.29 | 0.12 | 0.05 | 0.03 | 0.03 | 0.02 | 0.01 | 0 | -0.02 | 0 | 0.01 | 0.02 | 0.01 | 0 | 0.01 | 0.02 | 0.01 | 0 | 0 | 0 | 0.02 | 0 | 0.01 | 0.02 | 0 | 0.02 | 0 | 0 | 0.01 | 0 | 0 | 0.03 | 0.01 | 0 |
| PRE1_27 | 0.3 | 0.38 | 0.4 | 0.37 | 0.33 | 0.31 | 0.4 | 0.4 | 0.39 | 0.27 | 0.34 | 0.39 | 0.37 | 0.38 | 0.29 | 0.31 | 0.38 | 0.39 | 0.38 | 0.32 | 0.33 | 0.39 | 0.36 | 0.36 | 0.32 | 0.29 | 1 | 0.36 | 0.09 | 0.05 | 0.05 | 0 | 0.01 | -0.02 | 0.02 | 0.02 | 0.02 | 0.02 | 0.01 | 0 | 0.01 | 0.02 | 0.01 | 0 | 0.02 | 0.01 | 0.02 | 0.01 | 0.02 | 0.01 | 0 | 0.02 | 0.02 | 0.02 | 0.01 | 0.01 | 0.02 | 0.03 | 0.01 | 0 |
| PRE1_28 | 0.32 | 0.39 | 0.43 | 0.42 | 0.34 | 0.3 | 0.42 | 0.47 | 0.39 | 0.32 | 0.31 | 0.41 | 0.43 | 0.43 | 0.32 | 0.35 | 0.42 | 0.38 | 0.42 | 0.34 | 0.3 | 0.43 | 0.43 | 0.45 | 0.31 | 0.12 | 0.36 | 1 | 0.31 | 0.12 | 0.05 | 0 | 0 | 0 | 0.01 | 0.02 | 0.03 | 0.01 | 0.01 | 0.01 | 0 | 0.01 | 0.02 | 0.02 | 0.02 | 0.03 | 0.01 | 0 | 0.01 | 0.01 | 0.02 | 0 | 0.01 | 0.02 | 0.02 | 0.01 | 0.02 | 0.03 | 0 | 0.01 |
| PRE1_29 | 0.32 | 0.37 | 0.39 | 0.39 | 0.31 | 0.32 | 0.38 | 0.4 | 0.39 | 0.31 | 0.36 | 0.38 | 0.41 | 0.37 | 0.27 | 0.29 | 0.41 | 0.38 | 0.4 | 0.31 | 0.34 | 0.39 | 0.43 | 0.35 | 0.27 | 0.05 | 0.09 | 0.31 | 1 | 0.35 | 0.06 | 0.02 | 0.01 | 0.02 | 0.02 | 0.04 | 0.02 | 0.03 | 0.03 | 0.02 | 0.03 | 0.03 | 0.04 | 0.03 | 0.01 | 0.04 | 0.04 | 0.01 | 0.02 | 0.02 | 0.02 | 0.03 | 0.02 | 0.02 | 0.03 | 0.03 | 0.04 | 0.02 | 0.01 | 0.03 |
| PRE1_30 | 0.27 | 0.33 | 0.33 | 0.34 | 0.26 | 0.31 | 0.31 | 0.33 | 0.3 | 0.29 | 0.27 | 0.31 | 0.32 | 0.32 | 0.33 | 0.3 | 0.28 | 0.35 | 0.35 | 0.27 | 0.27 | 0.34 | 0.33 | 0.34 | 0.27 | 0.03 | 0.05 | 0.12 | 0.35 | 1 | 0.03 | 0.01 | 0.02 | 0.02 | 0 | 0.01 | 0.02 | 0.02 | 0.03 | 0.02 | 0.02 | 0.01 | 0.04 | 0.02 | 0.01 | 0.01 | 0.03 | 0.02 | 0.03 | 0.01 | 0.02 | 0.03 | 0.03 | 0.01 | 0 | 0.02 | 0.02 | 0.03 | 0.01 | 0.01 |
| POST1_1 | 0.16 | 0.05 | 0 | 0.01 | 0 | 0.04 | 0.04 | 0.05 | 0.06 | 0.03 | 0.04 | 0.06 | 0.03 | 0.06 | 0.03 | 0.03 | 0.07 | 0.06 | 0.03 | 0.02 | 0.04 | 0.04 | 0.05 | 0.04 | 0.03 | 0.03 | 0.05 | 0.05 | 0.06 | 0.03 | 1 | 0.32 | 0.1 | 0.04 | 0.01 | 0.28 | 0.34 | 0.31 | 0.3 | 0.25 | 0.26 | 0.32 | 0.31 | 0.32 | 0.26 | 0.27 | 0.31 | 0.31 | 0.31 | 0.27 | 0.27 | 0.31 | 0.31 | 0.31 | 0.27 | 0.26 | 0.3 | 0.32 | 0.31 | 0.28 |
| POST1_2 | 0.05 | 0.01 | 0 | 0 | -0.01 | 0.02 | 0.01 | 0.01 | 0.01 | 0 | 0.01 | 0.01 | 0.01 | 0.02 | 0 | 0 | 0.01 | 0.03 | 0 | 0.01 | 0.02 | 0.01 | 0.01 | 0.01 | -0.01 | 0.02 | 0 | 0 | 0.02 | 0.01 | 0.32 | 1 | 0.31 | 0.12 | 0.03 | 0.32 | 0.39 | 0.4 | 0.38 | 0.29 | 0.31 | 0.38 | 0.38 | 0.39 | 0.32 | 0.31 | 0.39 | 0.38 | 0.38 | 0.32 | 0.32 | 0.37 | 0.38 | 0.39 | 0.32 | 0.29 | 0.36 | 0.43 | 0.38 | 0.32 |
| POST1_3 | 0.02 | 0 | 0.01 | 0.02 | 0.01 | 0 | 0.01 | 0.02 | 0.03 | 0.01 | 0.02 | 0 | 0.01 | 0 | 0.03 | 0 | 0.01 | 0.01 | 0.02 | 0.03 | 0.01 | 0.01 | 0.01 | 0.01 | 0.03 | 0.01 | 0.01 | 0 | 0.01 | 0.02 | 0.1 | 0.31 | 1 | 0.32 | 0.11 | 0.3 | 0.38 | 0.42 | 0.4 | 0.33 | 0.3 | 0.39 | 0.43 | 0.4 | 0.31 | 0.32 | 0.4 | 0.4 | 0.38 | 0.33 | 0.33 | 0.4 | 0.4 | 0.38 | 0.32 | 0.31 | 0.38 | 0.42 | 0.39 | 0.33 |
| POST1_4 | 0.01 | 0 | 0.01 | 0.01 | 0 | 0 | 0.02 | 0 | 0.01 | 0.01 | 0.01 | 0.02 | 0.01 | 0 | -0.01 | 0.01 | 0.02 | -0.01 | 0.01 | 0 | 0.01 | -0.02 | 0 | 0.02 | 0.02 | 0 | -0.02 | 0 | 0.02 | 0.02 | 0.04 | 0.12 | 0.32 | 1 | 0.32 | 0.33 | 0.38 | 0.39 | 0.39 | 0.31 | 0.31 | 0.38 | 0.41 | 0.39 | 0.32 | 0.32 | 0.4 | 0.4 | 0.37 | 0.31 | 0.31 | 0.38 | 0.42 | 0.37 | 0.32 | 0.3 | 0.38 | 0.4 | 0.4 | 0.32 |
| POST1_5 | 0.01 | 0 | 0 | 0.02 | 0.02 | 0.01 | 0.01 | 0 | 0.01 | 0.01 | 0.03 | 0 | 0.01 | 0.01 | 0 | 0 | 0 | 0 | 0.03 | 0.01 | 0 | 0 | 0.01 | 0.01 | 0.02 | -0.02 | 0.02 | 0.01 | 0.02 | 0 | 0.01 | 0.03 | 0.11 | 0.32 | 1 | 0.25 | 0.31 | 0.32 | 0.34 | 0.27 | 0.27 | 0.31 | 0.33 | 0.31 | 0.27 | 0.26 | 0.31 | 0.33 | 0.32 | 0.27 | 0.27 | 0.33 | 0.34 | 0.3 | 0.24 | 0.25 | 0.31 | 0.33 | 0.31 | 0.28 |
| POST1_6 | 0.05 | 0.03 | 0.01 | 0 | -0.01 | 0 | 0.03 | 0.03 | 0.02 | 0 | 0.03 | 0.02 | 0 | 0.02 | 0.01 | 0 | 0.02 | 0.03 | 0.03 | 0 | 0.01 | 0.02 | 0.03 | 0.01 | 0.01 | 0 | 0.02 | 0.02 | 0.04 | 0.01 | 0.28 | 0.32 | 0.3 | 0.33 | 0.25 | 1 | 0.34 | 0.12 | 0.04 | -0.01 | 0.26 | 0.33 | 0.31 | 0.3 | 0.27 | 0.26 | 0.33 | 0.32 | 0.31 | 0.27 | 0.27 | 0.34 | 0.34 | 0.26 | 0.27 | 0.26 | 0.27 | 0.33 | 0.35 | 0.27 |
| POST1_7 | 0.05 | 0 | 0.01 | 0.02 | 0.02 | 0.01 | 0.03 | 0.01 | 0.02 | 0.02 | 0.02 | 0.03 | 0 | 0.02 | 0.02 | 0.01 | 0.03 | 0.03 | 0.01 | 0.01 | 0.01 | 0.02 | 0.01 | 0.02 | 0.03 | 0.01 | 0.02 | 0.03 | 0.02 | 0.02 | 0.34 | 0.39 | 0.38 | 0.38 | 0.31 | 0.34 | 1 | 0.31 | 0.12 | 0.04 | 0.31 | 0.37 | 0.37 | 0.4 | 0.34 | 0.3 | 0.38 | 0.39 | 0.4 | 0.33 | 0.33 | 0.37 | 0.39 | 0.38 | 0.33 | 0.29 | 0.38 | 0.42 | 0.38 | 0.32 |
| POST1_8 | 0.05 | 0.01 | 0.01 | 0.02 | 0 | 0.02 | 0.02 | 0.01 | 0.03 | 0.01 | 0.03 | 0.02 | 0.02 | 0.01 | 0.01 | 0.01 | 0.02 | 0.01 | 0.03 | 0.03 | 0.01 | 0.02 | 0.02 | 0.02 | 0.03 | 0.02 | 0.02 | 0.01 | 0.03 | 0.02 | 0.31 | 0.4 | 0.42 | 0.39 | 0.32 | 0.12 | 0.31 | 1 | 0.32 | 0.09 | 0.3 | 0.38 | 0.42 | 0.42 | 0.31 | 0.29 | 0.4 | 0.41 | 0.4 | 0.34 | 0.33 | 0.38 | 0.39 | 0.4 | 0.33 | 0.29 | 0.39 | 0.41 | 0.39 | 0.35 |
| POST1_9 | 0.06 | 0.01 | -0.01 | 0.01 | 0.01 | 0.02 | 0 | 0.02 | 0.03 | 0.01 | 0.01 | 0 | 0.03 | 0.02 | 0.02 | 0.01 | 0.01 | 0.02 | 0.01 | 0.02 | 0.03 | 0 | 0.02 | 0.02 | 0.02 | 0.01 | 0.01 | 0.01 | 0.03 | 0.03 | 0.3 | 0.38 | 0.4 | 0.39 | 0.34 | 0.04 | 0.12 | 0.32 | 1 | 0.33 | 0.31 | 0.39 | 0.41 | 0.38 | 0.32 | 0.33 | 0.4 | 0.39 | 0.38 | 0.31 | 0.32 | 0.37 | 0.41 | 0.4 | 0.31 | 0.32 | 0.39 | 0.42 | 0.37 | 0.32 |
| POST1_10 | 0.04 | 0 | 0 | 0.01 | 0 | 0.02 | 0.01 | 0.01 | 0 | 0.01 | 0.01 | 0.02 | 0.01 | 0.01 | 0 | 0.01 | 0.02 | 0.01 | 0 | 0 | 0.01 | -0.01 | 0.01 | 0.02 | 0.01 | 0 | 0 | 0.01 | 0.02 | 0.02 | 0.25 | 0.29 | 0.33 | 0.31 | 0.27 | -0.01 | 0.04 | 0.09 | 0.33 | 1 | 0.26 | 0.3 | 0.34 | 0.31 | 0.24 | 0.29 | 0.31 | 0.3 | 0.28 | 0.26 | 0.25 | 0.33 | 0.33 | 0.31 | 0.23 | 0.25 | 0.3 | 0.32 | 0.29 | 0.28 |
| POST1_11 | 0.05 | 0.02 | 0 | 0 | 0 | 0.02 | 0.02 | 0.01 | 0.02 | 0 | 0.02 | 0.03 | 0.03 | 0.01 | -0.01 | 0.02 | 0.01 | 0.01 | 0.01 | 0.02 | 0.03 | 0 | 0.02 | 0.01 | 0.01 | 0.01 | 0.01 | 0 | 0.03 | 0.02 | 0.26 | 0.31 | 0.3 | 0.31 | 0.27 | 0.26 | 0.31 | 0.3 | 0.31 | 0.26 | 1 | 0.29 | 0.1 | 0.06 | 0.01 | 0.29 | 0.35 | 0.29 | 0.27 | 0.25 | 0.28 | 0.3 | 0.32 | 0.3 | 0.26 | 0.24 | 0.26 | 0.34 | 0.33 | 0.28 |
| POST1_12 | 0.06 | 0.01 | 0 | 0.02 | 0 | 0.02 | 0.02 | 0 | 0.03 | 0.03 | 0.03 | 0.02 | 0.01 | 0.01 | 0.02 | 0.02 | 0.03 | 0.02 | 0.01 | 0.01 | 0.02 | 0 | 0.02 | 0.03 | 0.03 | 0.02 | 0.02 | 0.01 | 0.03 | 0.01 | 0.32 | 0.38 | 0.39 | 0.38 | 0.31 | 0.33 | 0.37 | 0.38 | 0.39 | 0.3 | 0.29 | 1 | 0.32 | 0.12 | 0.05 | 0.32 | 0.38 | 0.38 | 0.38 | 0.31 | 0.3 | 0.36 | 0.37 | 0.41 | 0.33 | 0.3 | 0.35 | 0.41 | 0.38 | 0.33 |
| POST1_13 | 0.05 | 0.01 | 0.02 | 0.02 | 0 | 0.02 | 0.03 | 0.02 | 0.03 | 0.01 | 0.03 | 0.02 | 0.01 | 0.03 | 0.02 | 0.02 | 0.03 | 0.03 | 0.02 | 0.01 | 0.01 | 0.01 | 0.02 | 0.04 | 0.03 | 0.01 | 0.01 | 0.02 | 0.04 | 0.04 | 0.31 | 0.38 | 0.43 | 0.41 | 0.33 | 0.31 | 0.37 | 0.42 | 0.41 | 0.34 | 0.1 | 0.32 | 1 | 0.33 | 0.12 | 0.31 | 0.38 | 0.42 | 0.43 | 0.33 | 0.3 | 0.4 | 0.45 | 0.38 | 0.32 | 0.31 | 0.4 | 0.42 | 0.38 | 0.35 |
| POST1_14 | 0.04 | 0.01 | 0 | 0 | 0.02 | 0.01 | 0.01 | 0.02 | 0.02 | 0.01 | 0.02 | 0 | 0.01 | 0.02 | 0.02 | 0.01 | 0.03 | 0.02 | 0.02 | 0.01 | 0.01 | 0.01 | 0.02 | 0.02 | 0.01 | 0 | 0 | 0.02 | 0.03 | 0.02 | 0.32 | 0.39 | 0.4 | 0.39 | 0.31 | 0.3 | 0.4 | 0.42 | 0.38 | 0.31 | 0.06 | 0.12 | 0.33 | 1 | 0.28 | 0.31 | 0.37 | 0.4 | 0.38 | 0.34 | 0.32 | 0.38 | 0.4 | 0.38 | 0.32 | 0.31 | 0.41 | 0.41 | 0.36 | 0.31 |
| POST1_15 | 0.03 | 0.01 | 0.01 | 0.01 | 0 | 0.01 | 0.02 | 0.02 | 0.01 | 0 | 0.01 | 0.01 | 0 | 0.02 | 0.01 | -0.01 | 0.01 | 0.01 | 0.03 | 0.02 | 0.01 | 0.02 | 0.01 | -0.01 | 0.02 | 0 | 0.02 | 0.02 | 0.01 | 0.01 | 0.26 | 0.32 | 0.31 | 0.32 | 0.27 | 0.27 | 0.34 | 0.31 | 0.32 | 0.24 | 0.01 | 0.05 | 0.12 | 0.28 | 1 | 0.25 | 0.33 | 0.33 | 0.3 | 0.27 | 0.3 | 0.34 | 0.31 | 0.28 | 0.24 | 0.24 | 0.31 | 0.33 | 0.33 | 0.27 |
| POST1_16 | 0.05 | 0.01 | 0.01 | 0.02 | 0 | 0.01 | 0.02 | 0.02 | 0.03 | 0.01 | 0.02 | 0.02 | 0.03 | 0.01 | 0 | 0 | 0.03 | 0.02 | 0.02 | 0.02 | 0.02 | 0 | 0.02 | 0.03 | 0.01 | 0 | 0.01 | 0.03 | 0.04 | 0.01 | 0.27 | 0.31 | 0.32 | 0.32 | 0.26 | 0.26 | 0.3 | 0.29 | 0.33 | 0.29 | 0.29 | 0.32 | 0.31 | 0.31 | 0.25 | 1 | 0.32 | 0.09 | 0.03 | 0.02 | 0.24 | 0.32 | 0.32 | 0.33 | 0.27 | 0.28 | 0.3 | 0.34 | 0.3 | 0.25 |
| POST1_17 | 0.06 | 0.02 | 0.01 | 0.03 | 0.01 | 0.02 | 0.03 | 0.02 | 0.03 | 0.02 | 0.02 | 0.02 | 0.03 | 0.03 | 0.02 | 0.01 | 0.03 | 0.02 | 0.03 | 0.03 | 0.01 | 0.03 | 0.04 | 0.03 | 0.02 | 0.02 | 0.02 | 0.01 | 0.04 | 0.03 | 0.31 | 0.39 | 0.4 | 0.4 | 0.31 | 0.33 | 0.38 | 0.4 | 0.4 | 0.31 | 0.35 | 0.38 | 0.38 | 0.37 | 0.33 | 0.32 | 1 | 0.32 | 0.11 | 0.07 | 0.32 | 0.41 | 0.39 | 0.36 | 0.32 | 0.31 | 0.36 | 0.42 | 0.4 | 0.33 |
| POST1_18 | 0.04 | 0 | -0.01 | 0 | 0.01 | 0.01 | 0.01 | 0.01 | 0.02 | 0 | 0.01 | 0 | 0.01 | 0.02 | 0 | 0.01 | 0.01 | 0.01 | 0.01 | 0 | 0.01 | -0.01 | 0.02 | 0.02 | 0.01 | 0 | 0.01 | 0 | 0.01 | 0.02 | 0.31 | 0.38 | 0.4 | 0.4 | 0.33 | 0.32 | 0.39 | 0.41 | 0.39 | 0.3 | 0.29 | 0.38 | 0.42 | 0.4 | 0.33 | 0.09 | 0.32 | 1 | 0.3 | 0.1 | 0.3 | 0.39 | 0.41 | 0.38 | 0.33 | 0.28 | 0.39 | 0.42 | 0.42 | 0.32 |
| POST1_19 | 0.06 | 0.02 | 0 | 0 | 0.01 | 0.02 | 0.01 | 0.02 | 0.02 | 0.01 | 0.02 | 0.02 | 0 | 0.02 | 0.02 | 0.02 | 0.01 | 0.02 | 0.03 | 0.01 | 0.01 | 0.01 | 0.01 | 0.01 | 0.04 | 0.01 | 0.02 | 0.01 | 0.02 | 0.03 | 0.31 | 0.38 | 0.38 | 0.37 | 0.32 | 0.31 | 0.4 | 0.4 | 0.38 | 0.28 | 0.27 | 0.38 | 0.43 | 0.38 | 0.3 | 0.03 | 0.11 | 0.3 | 1 | 0.33 | 0.32 | 0.35 | 0.4 | 0.39 | 0.3 | 0.29 | 0.38 | 0.38 | 0.36 | 0.35 |
| POST1_20 | 0.03 | 0.02 | 0.01 | 0 | 0 | 0.02 | 0.01 | 0.01 | 0.02 | 0.01 | 0.03 | 0.03 | 0 | 0 | 0 | 0.01 | 0.03 | 0.02 | 0.01 | 0 | 0.03 | 0.02 | 0 | 0 | 0.02 | 0.02 | 0.01 | 0.01 | 0.02 | 0.01 | 0.27 | 0.32 | 0.33 | 0.31 | 0.27 | 0.27 | 0.33 | 0.34 | 0.31 | 0.26 | 0.25 | 0.31 | 0.33 | 0.34 | 0.27 | 0.02 | 0.07 | 0.1 | 0.33 | 1 | 0.31 | 0.32 | 0.33 | 0.29 | 0.25 | 0.25 | 0.3 | 0.36 | 0.3 | 0.29 |
| POST1_21 | 0.04 | 0 | 0 | 0.01 | 0.01 | 0.01 | 0.02 | 0.02 | 0.02 | -0.01 | 0.02 | 0.01 | 0.01 | 0.01 | 0.01 | 0.01 | 0.01 | 0.01 | 0.01 | 0.02 | 0.01 | 0.02 | 0.01 | 0.01 | 0 | 0 | 0 | 0.02 | 0.02 | 0.02 | 0.27 | 0.32 | 0.33 | 0.31 | 0.27 | 0.27 | 0.33 | 0.33 | 0.32 | 0.25 | 0.28 | 0.3 | 0.3 | 0.32 | 0.3 | 0.24 | 0.32 | 0.3 | 0.32 | 0.31 | 1 | 0.33 | 0.14 | 0.02 | 0.02 | 0.25 | 0.29 | 0.32 | 0.34 | 0.31 |
| POST1_22 | 0.05 | 0.01 | 0.02 | 0.01 | 0.01 | 0.01 | 0.01 | 0.01 | 0.03 | 0.03 | 0.03 | 0.02 | 0.02 | 0.01 | 0.02 | 0.01 | 0.01 | 0.03 | 0.03 | 0.02 | 0.03 | 0.01 | 0.02 | 0.02 | 0.02 | 0.02 | 0.02 | 0 | 0.03 | 0.03 | 0.31 | 0.37 | 0.4 | 0.38 | 0.33 | 0.34 | 0.37 | 0.38 | 0.37 | 0.33 | 0.3 | 0.36 | 0.4 | 0.38 | 0.34 | 0.32 | 0.41 | 0.39 | 0.35 | 0.32 | 0.33 | 1 | 0.32 | 0.11 | 0.04 | 0.3 | 0.34 | 0.42 | 0.41 | 0.32 |
| POST1_23 | 0.05 | 0.01 | -0.01 | 0.01 | 0.02 | 0.03 | 0.01 | 0.02 | 0.02 | 0.01 | 0.01 | 0.02 | 0.02 | 0.02 | 0.02 | 0 | 0.04 | 0.01 | 0.02 | 0.02 | 0.03 | 0.01 | 0 | 0.01 | 0.03 | 0 | 0.02 | 0.01 | 0.02 | 0.03 | 0.31 | 0.38 | 0.4 | 0.42 | 0.34 | 0.34 | 0.39 | 0.39 | 0.41 | 0.33 | 0.32 | 0.37 | 0.45 | 0.4 | 0.31 | 0.32 | 0.39 | 0.41 | 0.4 | 0.33 | 0.14 | 0.32 | 1 | 0.29 | 0.09 | 0.31 | 0.36 | 0.44 | 0.39 | 0.35 |
| POST1_24 | 0.06 | 0.01 | 0 | 0 | 0 | 0.01 | 0.01 | 0.01 | 0.03 | 0.02 | 0.03 | 0.03 | 0 | 0.02 | 0 | 0.03 | 0.02 | 0.02 | 0.01 | -0.01 | 0.01 | 0.01 | 0.03 | 0.02 | 0.01 | 0 | 0.02 | 0.02 | 0.02 | 0.01 | 0.31 | 0.39 | 0.38 | 0.37 | 0.3 | 0.26 | 0.38 | 0.4 | 0.4 | 0.31 | 0.3 | 0.41 | 0.38 | 0.38 | 0.28 | 0.33 | 0.36 | 0.38 | 0.39 | 0.29 | 0.02 | 0.11 | 0.29 | 1 | 0.32 | 0.31 | 0.4 | 0.4 | 0.33 | 0.3 |
| POST1_25 | 0.04 | 0.02 | 0 | 0.01 | -0.02 | 0.02 | 0.03 | 0.01 | 0.01 | 0 | 0.02 | 0.01 | 0.01 | 0.03 | 0 | 0.01 | 0.02 | 0.01 | 0.02 | 0.01 | 0 | -0.01 | 0.02 | 0.03 | 0.03 | 0.01 | 0.01 | 0.02 | 0.03 | 0 | 0.27 | 0.32 | 0.32 | 0.32 | 0.24 | 0.27 | 0.33 | 0.33 | 0.31 | 0.23 | 0.26 | 0.33 | 0.32 | 0.32 | 0.24 | 0.27 | 0.32 | 0.33 | 0.3 | 0.25 | 0.02 | 0.04 | 0.09 | 0.32 | 1 | 0.24 | 0.33 | 0.33 | 0.31 | 0.26 |
| POST1_26 | 0.05 | 0 | 0.02 | 0 | 0.01 | 0.02 | 0.01 | 0.02 | 0.02 | 0.01 | 0.01 | 0.01 | 0.02 | 0.02 | 0.01 | 0.01 | 0.02 | 0.01 | 0.02 | 0.02 | 0.02 | 0.01 | 0.01 | 0 | 0.03 | 0 | 0.01 | 0.01 | 0.03 | 0.02 | 0.26 | 0.29 | 0.31 | 0.3 | 0.25 | 0.26 | 0.29 | 0.29 | 0.32 | 0.25 | 0.24 | 0.3 | 0.31 | 0.31 | 0.24 | 0.28 | 0.31 | 0.28 | 0.29 | 0.25 | 0.25 | 0.3 | 0.31 | 0.31 | 0.24 | 1 | 0.27 | 0.12 | 0.03 | 0.01 |
| POST1_27 | 0.06 | 0.02 | 0 | 0.02 | 0.01 | 0.02 | 0.02 | 0.01 | 0.02 | 0.02 | 0.02 | 0.03 | 0.02 | 0.01 | 0.01 | 0.02 | 0.02 | 0.01 | 0.03 | 0.01 | 0.02 | -0.01 | 0.02 | 0.03 | 0.03 | 0 | 0.02 | 0.02 | 0.04 | 0.02 | 0.3 | 0.36 | 0.38 | 0.38 | 0.31 | 0.27 | 0.38 | 0.39 | 0.39 | 0.3 | 0.26 | 0.35 | 0.4 | 0.41 | 0.31 | 0.3 | 0.36 | 0.39 | 0.38 | 0.3 | 0.29 | 0.34 | 0.36 | 0.4 | 0.33 | 0.27 | 1 | 0.31 | 0.11 | 0.03 |
| POST1_28 | 0.05 | 0.03 | 0.01 | 0.03 | 0.01 | 0.02 | 0.03 | 0.02 | 0.04 | 0.02 | 0.04 | 0.03 | 0.01 | 0.02 | 0.03 | 0.02 | 0.04 | 0.04 | 0.03 | 0.01 | 0.01 | 0.04 | 0.03 | 0.03 | 0.02 | 0.03 | 0.03 | 0.03 | 0.02 | 0.03 | 0.32 | 0.43 | 0.42 | 0.4 | 0.33 | 0.33 | 0.42 | 0.41 | 0.42 | 0.32 | 0.34 | 0.41 | 0.42 | 0.41 | 0.33 | 0.34 | 0.42 | 0.42 | 0.38 | 0.36 | 0.32 | 0.42 | 0.44 | 0.4 | 0.33 | 0.12 | 0.31 | 1 | 0.33 | 0.15 |
| POST1_29 | 0.04 | 0 | 0 | 0 | 0 | 0.01 | 0.01 | 0.02 | 0.01 | -0.01 | 0.02 | 0 | 0.01 | 0.01 | 0.01 | 0 | 0.01 | 0.01 | 0.01 | 0.01 | 0.01 | 0 | 0.01 | 0.02 | 0 | 0.01 | 0.01 | 0 | 0.01 | 0.01 | 0.31 | 0.38 | 0.39 | 0.4 | 0.31 | 0.35 | 0.38 | 0.39 | 0.37 | 0.29 | 0.33 | 0.38 | 0.38 | 0.36 | 0.33 | 0.3 | 0.4 | 0.42 | 0.36 | 0.3 | 0.34 | 0.41 | 0.39 | 0.33 | 0.31 | 0.03 | 0.11 | 0.33 | 1 | 0.32 |
| POST1_30 | 0.04 | 0.01 | 0 | 0 | -0.01 | 0 | 0.01 | 0.01 | 0.03 | 0 | 0.01 | 0.01 | 0 | 0.03 | 0 | 0 | 0.01 | 0.01 | 0.01 | 0.01 | 0.01 | 0.01 | 0 | 0.01 | 0.02 | 0 | 0 | 0.01 | 0.03 | 0.01 | 0.28 | 0.32 | 0.33 | 0.32 | 0.28 | 0.27 | 0.32 | 0.35 | 0.32 | 0.28 | 0.28 | 0.33 | 0.35 | 0.31 | 0.27 | 0.25 | 0.33 | 0.32 | 0.35 | 0.29 | 0.31 | 0.32 | 0.35 | 0.3 | 0.26 | 0.01 | 0.03 | 0.15 | 0.32 | 1 |
# mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP:
PRE_alpha = CronbachAlpha(EMA_30.30[pre_30mzp])
POST_alpha = CronbachAlpha(EMA_30.30[post_30mzp])
EMA_30.30_Alpha = FisherZInv(mean(c(FisherZ(PRE_alpha), FisherZ(POST_alpha))))Korrelation zwischen den Pre- und Post-Intervall-Mittelwerten = 0.047.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Pre-MZP (Fisher-Z-transformiert): r = 0.31.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Post-MZP (Fisher-Z-transformiert): r = 0.31.
Mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP = 0.932.
# Korrelationsmatrix von PRE- und POST-MZP:
EMA_5.5_Window_KorMat = cor(EMA_5.5_Window[, c(pre_5mzp, post_5mzp)]) %>%
round(., digits = 2)
# durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden MZP (beachte: ohne Fisher-Z-Transformation):
pre_inter_item_rtt = 0L
for (i in 1:4) {
pre_inter_item_rtt = pre_inter_item_rtt + FisherZ(EMA_5.5_Window_KorMat[i,i+1])
}
pre_inter_item_rtt = FisherZInv(pre_inter_item_rtt / 4)
post_inter_item_rtt = 0L
for (i in 5:9) {
post_inter_item_rtt = post_inter_item_rtt + FisherZ(EMA_5.5_Window_KorMat[i,i+1])
}
post_inter_item_rtt = FisherZInv(post_inter_item_rtt / 4)
for (i in 1:9) {
EMA_5.5_Window_KorMat[i, i+1] = cell_spec(EMA_5.5_Window_KorMat[i, i+1], "html", bold = TRUE)
}
rownames(EMA_5.5_Window_KorMat) = cell_spec(rownames(EMA_5.5_Window_KorMat), "html", bold = TRUE)
EMA_5.5_Window_KorMat %>%
kable(., format = "html", escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, fixed_thead = T)| PRE1_1 | PRE1_2 | PRE1_3 | PRE1_4 | PRE1_5 | POST1_1 | POST1_2 | POST1_3 | POST1_4 | POST1_5 | |
|---|---|---|---|---|---|---|---|---|---|---|
| PRE1_1 | 1 | 0.32 | 0.18 | 0.24 | 0.3 | 0.02 | 0 | 0.02 | 0.03 | 0.01 |
| PRE1_2 | 0.32 | 1 | 0.3 | 0.19 | 0.22 | 0.03 | 0.02 | 0.01 | 0.02 | 0.02 |
| PRE1_3 | 0.18 | 0.3 | 1 | 0.31 | 0.17 | 0.02 | 0.02 | 0.02 | 0.02 | 0.02 |
| PRE1_4 | 0.24 | 0.19 | 0.31 | 1 | 0.31 | 0.01 | 0.03 | 0.03 | 0.01 | 0.02 |
| PRE1_5 | 0.3 | 0.22 | 0.17 | 0.31 | 1 | 0.03 | 0.01 | 0.02 | 0.01 | 0.02 |
| POST1_1 | 0.02 | 0.03 | 0.02 | 0.01 | 0.03 | 1 | 0.3 | 0.19 | 0.21 | 0.26 |
| POST1_2 | 0 | 0.02 | 0.02 | 0.03 | 0.01 | 0.3 | 1 | 0.3 | 0.19 | 0.19 |
| POST1_3 | 0.02 | 0.01 | 0.02 | 0.03 | 0.02 | 0.19 | 0.3 | 1 | 0.31 | 0.17 |
| POST1_4 | 0.03 | 0.02 | 0.02 | 0.01 | 0.01 | 0.21 | 0.19 | 0.31 | 1 | 0.32 |
| POST1_5 | 0.01 | 0.02 | 0.02 | 0.02 | 0.02 | 0.26 | 0.19 | 0.17 | 0.32 | 1 |
# mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP:
PRE_alpha = CronbachAlpha(EMA_5.5_Window[pre_5mzp])
POST_alpha = CronbachAlpha(EMA_5.5_Window[post_5mzp])
EMA_5.5_Window_Alpha = FisherZInv(mean(c(FisherZ(PRE_alpha), FisherZ(POST_alpha))))Korrelation zwischen den Pre- und Post-Intervall-Mittelwerten = 0.045.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Pre-MZP (Fisher-Z-transformiert): r = 0.31.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Post-MZP (Fisher-Z-transformiert): r = 0.31.
Mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP = 0.623.
# Korrelationsmatrix von PRE- und POST-MZP:
EMA_5.5_Days_KorMat = cor(EMA_5.5_Days[, c(pre_5mzp, post_5mzp)]) %>%
round(., digits = 2)
# durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden MZP (beachte: ohne Fisher-Z-Transformation):
pre_inter_item_rtt = 0L
for (i in 1:4) {
pre_inter_item_rtt = pre_inter_item_rtt + FisherZ(EMA_5.5_Days_KorMat[i,i+1])
}
pre_inter_item_rtt = FisherZInv(pre_inter_item_rtt / 4)
post_inter_item_rtt = 0L
for (i in 5:9) {
post_inter_item_rtt = post_inter_item_rtt + FisherZ(EMA_5.5_Days_KorMat[i,i+1])
}
post_inter_item_rtt = FisherZInv(post_inter_item_rtt / 4)
for (i in 1:9) {
EMA_5.5_Days_KorMat[i, i+1] = cell_spec(EMA_5.5_Days_KorMat[i, i+1], "html", bold = TRUE)
}
rownames(EMA_5.5_Days_KorMat) = cell_spec(rownames(EMA_5.5_Days_KorMat), "html", bold = TRUE)
EMA_5.5_Days_KorMat %>%
kable(., format = "html", escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, fixed_thead = T)| PRE1_1 | PRE1_2 | PRE1_3 | PRE1_4 | PRE1_5 | POST1_1 | POST1_2 | POST1_3 | POST1_4 | POST1_5 | |
|---|---|---|---|---|---|---|---|---|---|---|
| PRE1_1 | 1 | 0.28 | 0.34 | 0.36 | 0.33 | 0 | 0.02 | 0.01 | 0 | 0.02 |
| PRE1_2 | 0.28 | 1 | 0.3 | 0.35 | 0.35 | 0 | 0.02 | 0.01 | 0 | 0.02 |
| PRE1_3 | 0.34 | 0.3 | 1 | 0.31 | 0.36 | 0 | 0.02 | 0.01 | 0.01 | 0.02 |
| PRE1_4 | 0.36 | 0.35 | 0.31 | 1 | 0.28 | -0.01 | 0.01 | 0 | -0.02 | -0.01 |
| PRE1_5 | 0.33 | 0.35 | 0.36 | 0.28 | 1 | 0.01 | 0.01 | 0.02 | 0.02 | 0.01 |
| POST1_1 | 0 | 0 | 0 | -0.01 | 0.01 | 1 | 0.28 | 0.34 | 0.35 | 0.33 |
| POST1_2 | 0.02 | 0.02 | 0.02 | 0.01 | 0.01 | 0.28 | 1 | 0.3 | 0.34 | 0.32 |
| POST1_3 | 0.01 | 0.01 | 0.01 | 0 | 0.02 | 0.34 | 0.3 | 1 | 0.31 | 0.32 |
| POST1_4 | 0 | 0 | 0.01 | -0.02 | 0.02 | 0.35 | 0.34 | 0.31 | 1 | 0.29 |
| POST1_5 | 0.02 | 0.02 | 0.02 | -0.01 | 0.01 | 0.33 | 0.32 | 0.32 | 0.29 | 1 |
# mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP:
PRE_alpha = CronbachAlpha(EMA_5.5_Days[pre_5mzp])
POST_alpha = CronbachAlpha(EMA_5.5_Days[post_5mzp])
EMA_5.5_Days_Alpha = FisherZInv(mean(c(FisherZ(PRE_alpha), FisherZ(POST_alpha))))Korrelation zwischen den Pre- und Post-Intervall-Mittelwerten = 0.016.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Pre-MZP (Fisher-Z-transformiert): r = 0.29.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Post-MZP (Fisher-Z-transformiert): r = 0.3.
Mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP = 0.703.
Verteilungen der Pre-Post-Mittelwerts-Veränderungen
temp = tibble(MeanDiffs = c(EMA_5.5$MeanDiff, EMA_30.30$MeanDiff, EMA_5.5_Window$MeanDiff, EMA_5.5_Days$MeanDiff),
Datasets = rep(as_factor(c("EMA_5.5", "EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days")), each = length(EMA_5.5$MeanDiff)))#<<
temp %>%
ggplot(aes(x = MeanDiffs, fill = Datasets)) +
geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
labs(x = "PHQ-9 Pre-Post Difference", y = "")#<<#ggsave("Plots/k20_PP-Datasets_Pre-Post-Diff_Histogram.jpg", width = 6, height = 4)#<<
scatter.hist(EMA_5.5$MeanDiff, EMA_30.30$MeanDiff, xlab = "EMA_5.5$MeanDiff",
ylab = "EMA_30.30$MeanDiff", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))scatter.hist(EMA_5.5$MeanDiff, EMA_5.5_Window$MeanDiff, xlab = "EMA_5.5$MeanDiff",
ylab = "EMA_5.5_Window$MeanDiff", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))scatter.hist(EMA_5.5$MeanDiff, EMA_5.5_Days$MeanDiff, xlab = "EMA_5.5$MeanDiff",
ylab = "EMA_5.5_Days$MeanDiff", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))scatter.hist(EMA_5.5_Window$MeanDiff, EMA_5.5_Days$MeanDiff, xlab = "EMA_5.5_Window$MeanDiff",
ylab = "EMA_5.5_Days$MeanDiff", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Korrelation zwischen den Pre-Post-Differenzen in EMA_5.5 und EMA_30.30 = 1.
Korrelation zwischen den Pre-Post-Differenzen in EMA_5.5_Window und EMA_30.30 = 0.913.
Korrelation zwischen den Pre-Post-Differenzen in EMA_5.5_Days und EMA_30.30 = 0.859.
Prozentuale Überlappung der Pre-Post-Mittelwerts-Veränderungen
# Overlap-Plots zum Vergleich
final.plot(list(EMA_5.5_MeanDiff = EMA_5.5$MeanDiff, EMA_30.30_MeanDiff = EMA_30.30$MeanDiff),
overlap(list(EMA_5.5_MeanDiff = EMA_5.5$MeanDiff, EMA_30.30_MeanDiff = EMA_30.30$MeanDiff))$OV)final.plot(list(EMA_5.5_Window_MeanDiff = EMA_5.5_Window$MeanDiff, EMA_30.30_MeanDiff = EMA_30.30$MeanDiff),
overlap(list(EMA_5.5_Window_MeanDiff = EMA_5.5_Window$MeanDiff, EMA_30.30_MeanDiff = EMA_30.30$MeanDiff))$OV)final.plot(list(EMA_5.5_Days_MeanDiff = EMA_5.5_Days$MeanDiff, EMA_30.30_MeanDiff = EMA_30.30$MeanDiff),
overlap(list(EMA_5.5_Days_MeanDiff = EMA_5.5_Days$MeanDiff, EMA_30.30_MeanDiff = EMA_30.30$MeanDiff))$OV)final.plot(list(EMA_5.5_Window_MeanDiff = EMA_5.5_Window$MeanDiff, EMA_5.5_Days_MeanDiff = EMA_5.5_Days$MeanDiff),
overlap(list(EMA_5.5_Window_MeanDiff = EMA_5.5_Window$MeanDiff, EMA_5.5_Days_MeanDiff = EMA_5.5_Days$MeanDiff))$OV)Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-Intervall in EMA_5.5 (je 5 MZP)
\[ d = \frac{\overline{x_{1}} - \overline{x_{2}}} {\sqrt{0.5 \cdot (s_{x}^2 + s_{y}^2)}} \]
\(\overline{x_{1}}\) = mean of subject´s pretest scores, \(\overline{x_{2}}\) = mean of subject´s posttest scores, \(s_{x}\) = individual standard deviation of pretest time points, \(s_{y}\) = individual standard deviation of posttest time points
EMA_5.5$Cohen_d = (EMA_5.5$PRE_Mean - EMA_5.5$POST_Mean) / sqrt(0.5 * (EMA_5.5$ind.pretestSD^2 + EMA_5.5$ind.posttestSD^2))
# Sollen Cohen_d %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5 = EMA_5.5 %>%
# within(., {Cohen_d[Cohen_d %in% c(-Inf,Inf)] = NA})
#hist(EMA_5.5$Cohen_d, col = "lightblue1", main = "EMA_5.5$Cohen_d")
cohen_d_5.5 = (mean(EMA_5.5$PRE_Mean) - mean(EMA_5.5$POST_Mean)) / sqrt(0.5 * (mean(EMA_5.5$ind.pretestSD)^2 +
mean(EMA_5.5$ind.posttestSD)^2))
final.plot(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_5.5_POST_Mean = EMA_5.5$POST_Mean),
overlap(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_5.5_POST_Mean = EMA_5.5$POST_Mean))$OV)Gepoolte Varianz zwischen Pre- und Post-Intervall-Mittelwerten in EMA_5.5 = 3.007.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten (für jede Person einzeln berechnet) in EMA_5.5 = 1.174.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten in EMA_5.5 = 1.027.
Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-Intervall in den erweiterten Intervall-Daten (je 30 MZP)
EMA_30.30$Cohen_d = (EMA_30.30$PRE_Mean - EMA_30.30$POST_Mean) / sqrt(0.5 * (EMA_30.30$ind.pretestSD^2 + EMA_30.30$ind.posttestSD^2))
# Sollen Cohen_d %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_30.30 = EMA_30.30 %>%
# within(., {Cohen_d[Cohen_d %in% c(-Inf,Inf)] = NA})
#hist(EMA_30.30$Cohen_d, col = "lightblue1", main = "EMA_30.30$Cohen_d")
cohen_d_30.30 = (mean(EMA_30.30$PRE_Mean) - mean(EMA_30.30$POST_Mean)) / sqrt(0.5 * (mean(EMA_30.30$ind.pretestSD)^2 +
mean(EMA_30.30$ind.posttestSD)^2))
final.plot(list(EMA_30.30_PRE_Mean = EMA_30.30$PRE_Mean, EMA_30.30_POST_Mean = EMA_30.30$POST_Mean),
overlap(list(EMA_30.30_PRE_Mean = EMA_30.30$PRE_Mean, EMA_30.30_POST_Mean = EMA_30.30$POST_Mean))$OV)Gepoolte Varianz zwischen Pre- und Post-Intervall-Mittelwerten in EMA_30.30 = 3.007.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten (für jede Person einzeln berechnet) in EMA_30.30 = 1.291.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten in EMA_30.30 = 1.129.
Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-Intervall in EMA_5.5_Window (je 5 MZP)
EMA_5.5_Window$Cohen_d = (EMA_5.5_Window$PRE_Mean - EMA_5.5_Window$POST_Mean) / sqrt(0.5 * (EMA_5.5_Window$ind.pretestSD^2 + EMA_5.5_Window$ind.posttestSD^2))
# Sollen Cohen_d %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Window = EMA_5.5_Window %>%
# within(., {Cohen_d[Cohen_d %in% c(-Inf,Inf)] = NA})
#hist(EMA_5.5_Window$Cohen_d, col = "lightblue1", main = "EMA_5.5_Window$Cohen_d")
cohen_d_5.5_Window = (mean(EMA_5.5_Window$PRE_Mean) - mean(EMA_5.5_Window$POST_Mean)) / sqrt(0.5 * (mean(EMA_5.5_Window$ind.pretestSD)^2 + mean(EMA_5.5_Window$ind.posttestSD)^2))
final.plot(list(EMA_5.5_Window_PRE_Mean = EMA_5.5_Window$PRE_Mean, EMA_5.5_Window_POST_Mean = EMA_5.5_Window$POST_Mean),
overlap(list(EMA_5.5_Window_PRE_Mean = EMA_5.5_Window$PRE_Mean, EMA_5.5_Window_POST_Mean = EMA_5.5_Window$POST_Mean))$OV)Gepoolte Varianz zwischen Pre- und Post-Intervall-Mittelwerten in EMA_5.5_Window = 3.256.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten (für jede Person einzeln berechnet) in EMA_5.5_Window = 1.307.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten in EMA_5.5_Window = 1.113.
Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-Intervall in EMA_5.5_Days (je 5 MZP)
EMA_5.5_Days$Cohen_d = (EMA_5.5_Days$PRE_Mean - EMA_5.5_Days$POST_Mean) / sqrt(0.5 * (EMA_5.5_Days$ind.pretestSD^2 + EMA_5.5_Days$ind.posttestSD^2))
# Sollen Cohen_d %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Days = EMA_5.5_Days %>%
# within(., {Cohen_d[Cohen_d %in% c(-Inf,Inf)] = NA})
#hist(EMA_5.5_Days$Cohen_d, col = "lightblue1", main = "EMA_5.5_Days$Cohen_d")
cohen_d_5.5_Days = (mean(EMA_5.5_Days$PRE_Mean) - mean(EMA_5.5_Days$POST_Mean)) / sqrt(0.5 * (mean(EMA_5.5_Days$ind.pretestSD)^2 + mean(EMA_5.5_Days$ind.posttestSD)^2))
final.plot(list(EMA_5.5_Days_PRE_Mean = EMA_5.5_Days$PRE_Mean, EMA_5.5_Days_POST_Mean = EMA_5.5_Days$POST_Mean),
overlap(list(EMA_5.5_Days_PRE_Mean = EMA_5.5_Days$PRE_Mean, EMA_5.5_Days_POST_Mean = EMA_5.5_Days$POST_Mean))$OV)Gepoolte Varianz zwischen Pre- und Post-Intervall-Mittelwerten in EMA_5.5_Days = 3.513.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten (für jede Person einzeln berechnet) in EMA_5.5_Days = 1.437.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten in EMA_5.5_Days = 1.179.
Ab hier nur noch Vergleiche in EMA_30.30, EMA_5.5_Window und EMA_5.5_Days:
PHQ_Int = tibble(PHQ_Score = c("0-4","5-9","10-14","15-19","20-27"),
Klassifikation = c(0,1,2,3,4),
Interpretation = c("Minimal or none","Mild","Moderate","Moderately severe","Severe"))EMA_30.30 = EMA_30.30 %>%
mutate(PRE_Mean_klass = case_when(
PRE_Mean <= 4 ~ 0,
PRE_Mean > 4 & PRE_Mean < 10 ~ 1,
PRE_Mean >= 10 & PRE_Mean < 15 ~ 2,
PRE_Mean >= 15 & PRE_Mean < 20 ~ 3,
PRE_Mean >= 20 ~ 4,
TRUE ~ PRE_Mean
)
)
temp = EMA_30.30 %>%
count(PRE_Mean_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PHQ_Int %>%
dplyr::rename(PRE_Mean_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PHQ_Score | PRE_Mean_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| 0-4 | 0 | Minimal or none | NA | NA |
| 5-9 | 1 | Mild | 3283 | 40.83 |
| 10-14 | 2 | Moderate | 4732 | 58.86 |
| 15-19 | 3 | Moderately severe | 25 | 0.31 |
| 20-27 | 4 | Severe | NA | NA |
EMA_30.30 = EMA_30.30 %>%
mutate(POST_Mean_klass = case_when(
POST_Mean <= 4 ~ 0,
POST_Mean > 4 & POST_Mean < 10 ~ 1,
POST_Mean >= 10 & POST_Mean < 15 ~ 2,
POST_Mean >= 15 & POST_Mean < 20 ~ 3,
POST_Mean >= 20 ~ 4,
TRUE ~ POST_Mean
)
)
temp = EMA_30.30 %>%
count(POST_Mean_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PHQ_Int %>%
dplyr::rename(POST_Mean_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PHQ_Score | POST_Mean_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| 0-4 | 0 | Minimal or none | 862 | 10.72 |
| 5-9 | 1 | Mild | 6126 | 76.19 |
| 10-14 | 2 | Moderate | 1052 | 13.08 |
| 15-19 | 3 | Moderately severe | NA | NA |
| 20-27 | 4 | Severe | NA | NA |
temp = tibble(Classification = c(EMA_30.30$PRE_Mean_klass, EMA_30.30$POST_Mean_klass),
Assessment = rep(as_factor(c("PRE Interval Mean", "POST Interval Mean")), each = length(EMA_30.30$PRE_Mean_klass)))#<<
temp %>%
ggplot(aes(x = Classification, fill = Assessment)) +
geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
labs(x = "PHQ-9 Classification", y = "")#<<#ggsave("Plots/k20_EMA_30.30_PHQ-Class_Histogram.jpg", width = 6, height = 4)#<<EMA_5.5_Window = EMA_5.5_Window %>%
mutate(PRE_Mean_klass = case_when(
PRE_Mean <= 4 ~ 0,
PRE_Mean > 4 & PRE_Mean < 10 ~ 1,
PRE_Mean >= 10 & PRE_Mean < 15 ~ 2,
PRE_Mean >= 15 & PRE_Mean < 20 ~ 3,
PRE_Mean >= 20 ~ 4,
TRUE ~ PRE_Mean
)
)
temp = EMA_5.5_Window %>%
count(PRE_Mean_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PHQ_Int %>%
dplyr::rename(PRE_Mean_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PHQ_Score | PRE_Mean_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| 0-4 | 0 | Minimal or none | 3 | 0.04 |
| 5-9 | 1 | Mild | 3316 | 41.24 |
| 10-14 | 2 | Moderate | 4651 | 57.85 |
| 15-19 | 3 | Moderately severe | 70 | 0.87 |
| 20-27 | 4 | Severe | NA | NA |
EMA_5.5_Window = EMA_5.5_Window %>%
mutate(POST_Mean_klass = case_when(
POST_Mean <= 4 ~ 0,
POST_Mean > 4 & POST_Mean < 10 ~ 1,
POST_Mean >= 10 & POST_Mean < 15 ~ 2,
POST_Mean >= 15 & POST_Mean < 20 ~ 3,
POST_Mean >= 20 ~ 4,
TRUE ~ POST_Mean
)
)
temp = EMA_5.5_Window %>%
count(POST_Mean_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PHQ_Int %>%
dplyr::rename(POST_Mean_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PHQ_Score | POST_Mean_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| 0-4 | 0 | Minimal or none | 983 | 12.23 |
| 5-9 | 1 | Mild | 5842 | 72.66 |
| 10-14 | 2 | Moderate | 1212 | 15.07 |
| 15-19 | 3 | Moderately severe | 3 | 0.04 |
| 20-27 | 4 | Severe | NA | NA |
temp = tibble(Classification = c(EMA_5.5_Window$PRE_Mean_klass, EMA_5.5_Window$POST_Mean_klass),
Assessment = rep(as_factor(c("PRE Interval Mean", "POST Interval Mean")), each = length(EMA_5.5_Window$PRE_Mean_klass)))#<<
temp %>%
ggplot(aes(x = Classification, fill = Assessment)) +
geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
labs(x = "PHQ-9 Classification", y = "")#<<#ggsave("Plots/k20_EMA_5.5_Window_PHQ-Class_Histogram.jpg", width = 6, height = 4)#<<EMA_5.5_Days = EMA_5.5_Days %>%
mutate(PRE_Mean_klass = case_when(
PRE_Mean <= 4 ~ 0,
PRE_Mean > 4 & PRE_Mean < 10 ~ 1,
PRE_Mean >= 10 & PRE_Mean < 15 ~ 2,
PRE_Mean >= 15 & PRE_Mean < 20 ~ 3,
PRE_Mean >= 20 ~ 4,
TRUE ~ PRE_Mean
)
)
temp = EMA_5.5_Days %>%
count(PRE_Mean_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PHQ_Int %>%
dplyr::rename(PRE_Mean_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PHQ_Score | PRE_Mean_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| 0-4 | 0 | Minimal or none | 13 | 0.16 |
| 5-9 | 1 | Mild | 3388 | 42.14 |
| 10-14 | 2 | Moderate | 4506 | 56.04 |
| 15-19 | 3 | Moderately severe | 133 | 1.65 |
| 20-27 | 4 | Severe | NA | NA |
EMA_5.5_Days = EMA_5.5_Days %>%
mutate(POST_Mean_klass = case_when(
POST_Mean <= 4 ~ 0,
POST_Mean > 4 & POST_Mean < 10 ~ 1,
POST_Mean >= 10 & POST_Mean < 15 ~ 2,
POST_Mean >= 15 & POST_Mean < 20 ~ 3,
POST_Mean >= 20 ~ 4,
TRUE ~ POST_Mean
)
)
temp = EMA_5.5_Days %>%
count(POST_Mean_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PHQ_Int %>%
dplyr::rename(POST_Mean_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PHQ_Score | POST_Mean_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| 0-4 | 0 | Minimal or none | 1135 | 14.12 |
| 5-9 | 1 | Mild | 5562 | 69.18 |
| 10-14 | 2 | Moderate | 1318 | 16.39 |
| 15-19 | 3 | Moderately severe | 25 | 0.31 |
| 20-27 | 4 | Severe | NA | NA |
temp = tibble(Classification = c(EMA_5.5_Days$PRE_Mean_klass, EMA_5.5_Days$POST_Mean_klass),
Assessment = rep(as_factor(c("PRE Interval Mean", "POST Interval Mean")), each = length(EMA_5.5_Days$PRE_Mean_klass)))#<<
temp %>%
ggplot(aes(x = Classification, fill = Assessment)) +
geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
labs(x = "PHQ-9 Classification", y = "")#<<#ggsave("Plots/k20_EMA_5.5_Days_PHQ-Class_Histogram.jpg", width = 6, height = 4)#<<
\[
PC = \Bigl(1 - \frac{\overline{x_{2}}} {\overline{x_{1}}}\Bigr) \cdot 100
\]
\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores
Interpretation des Percentage Change:
PC_Int = tibble(PC = c("PC <= -50","-50 < PC <= -25","-25 < PC < 25","25 <= PC < 50","PC >= 50"),
Klassifikation = c(-2,-1,0,1,2),
Interpretation = c("starke Verschlechterung","Verschlechterung","keine Veränderung",
"Verbesserung","starke Verbesserung"))EMA_30.30$Mean_PC = (1-(EMA_30.30$POST_Mean / EMA_30.30$PRE_Mean)) * 100
# Sollen Mean_PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_30.30 = EMA_30.30 %>%
# within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})
EMA_30.30 = EMA_30.30 %>%
mutate(Mean_PC_klass = case_when(
Mean_PC <= -50 ~ -2,
Mean_PC > -50 & Mean_PC <= -25 ~ -1,
Mean_PC > -25 & Mean_PC < 25 ~ 0,
Mean_PC >= 25 & Mean_PC < 50 ~ 1,
Mean_PC >= 50 ~ 2,
TRUE ~ Mean_PC
)
)
temp = EMA_30.30 %>%
dplyr::count(Mean_PC_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PC_Int %>%
dplyr::rename(Mean_PC_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PC | Mean_PC_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| PC <= -50 | -2 | starke Verschlechterung | 73 | 0.91 |
| -50 < PC <= -25 | -1 | Verschlechterung | 240 | 2.99 |
| -25 < PC < 25 | 0 | keine Veränderung | 2919 | 36.31 |
| 25 <= PC < 50 | 1 | Verbesserung | 2909 | 36.18 |
| PC >= 50 | 2 | starke Verbesserung | 1899 | 23.62 |
scatter.hist(EMA_30.30$PRE_Mean, EMA_30.30$Mean_PC, xlab = "EMA_30.30$PRE_Mean", ylab = "EMA_30.30$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Korrelation Mean Percentage Change (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = 0.468.
EMA_5.5_Window$Mean_PC = (1-(EMA_5.5_Window$POST_Mean / EMA_5.5_Window$PRE_Mean)) * 100
# Sollen Mean_PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Window = EMA_5.5_Window %>%
# within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})
EMA_5.5_Window = EMA_5.5_Window %>%
mutate(Mean_PC_klass = case_when(
Mean_PC <= -50 ~ -2,
Mean_PC > -50 & Mean_PC <= -25 ~ -1,
Mean_PC > -25 & Mean_PC < 25 ~ 0,
Mean_PC >= 25 & Mean_PC < 50 ~ 1,
Mean_PC >= 50 ~ 2,
TRUE ~ Mean_PC
)
)
temp = EMA_5.5_Window %>%
dplyr::count(Mean_PC_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PC_Int %>%
dplyr::rename(Mean_PC_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PC | Mean_PC_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| PC <= -50 | -2 | starke Verschlechterung | 123 | 1.53 |
| -50 < PC <= -25 | -1 | Verschlechterung | 313 | 3.89 |
| -25 < PC < 25 | 0 | keine Veränderung | 2791 | 34.71 |
| 25 <= PC < 50 | 1 | Verbesserung | 2754 | 34.25 |
| PC >= 50 | 2 | starke Verbesserung | 2059 | 25.61 |
scatter.hist(EMA_5.5_Window$PRE_Mean, EMA_5.5_Window$Mean_PC, xlab = "EMA_5.5_Window$PRE_Mean", ylab = "EMA_5.5_Window$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Korrelation Mean Percentage Change (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = 0.474.
EMA_5.5_Days$Mean_PC = (1-(EMA_5.5_Days$POST_Mean / EMA_5.5_Days$PRE_Mean)) * 100
# Sollen Mean_PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Days = EMA_5.5_Days %>%
# within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})
EMA_5.5_Days = EMA_5.5_Days %>%
mutate(Mean_PC_klass = case_when(
Mean_PC <= -50 ~ -2,
Mean_PC > -50 & Mean_PC <= -25 ~ -1,
Mean_PC > -25 & Mean_PC < 25 ~ 0,
Mean_PC >= 25 & Mean_PC < 50 ~ 1,
Mean_PC >= 50 ~ 2,
TRUE ~ Mean_PC
)
)
temp = EMA_5.5_Days %>%
dplyr::count(Mean_PC_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PC_Int %>%
dplyr::rename(Mean_PC_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PC | Mean_PC_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| PC <= -50 | -2 | starke Verschlechterung | 225 | 2.80 |
| -50 < PC <= -25 | -1 | Verschlechterung | 374 | 4.65 |
| -25 < PC < 25 | 0 | keine Veränderung | 2635 | 32.77 |
| 25 <= PC < 50 | 1 | Verbesserung | 2550 | 31.72 |
| PC >= 50 | 2 | starke Verbesserung | 2256 | 28.06 |
scatter.hist(EMA_5.5_Days$PRE_Mean, EMA_5.5_Days$Mean_PC, xlab = "EMA_5.5_Days$PRE_Mean", ylab = "EMA_5.5_Days$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Korrelation Mean Percentage Change (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = 0.494.
scatter.hist(EMA_30.30$Mean_PC, EMA_5.5_Window$Mean_PC, xlab = "EMA_30.30$Mean_PC", ylab = "EMA_5.5_Window$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))
scatter.hist(EMA_30.30$Mean_PC, EMA_5.5_Days$Mean_PC, xlab = "EMA_30.30$Mean_PC", ylab = "EMA_5.5_Days$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))
scatter.hist(EMA_5.5_Window$Mean_PC, EMA_5.5_Days$Mean_PC, xlab = "EMA_5.5_Window$Mean_PC", ylab = "EMA_5.5_Days$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))
\[
RCI_{ind,preSD} = \frac{\overline{x_{2}} - \overline{x_{1}}} {SE_{D,pre}}
\]
\[ SE_{D,pre} = \sqrt{2 \cdot (s_{x} \cdot (1 - r_{xy})^2)} \]
\[ \text{significance cutoff} = 1.96 \cdot SE_{D,pre} = 1.96 \cdot \sqrt{2 \cdot (s_{x} \cdot (1 - r_{xy})^2)} \]
\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores, \(SE_{D,pre}\) = standard error of difference between the test scores in the individual´s pre interval \(s_{x}\) = individual standard deviation of pretest time points, \(r_{xy}\) = reliability (internal consistency Cronbach´s \(\alpha\)) of the measure, \(\text{significance cutoff}\) = (absolute) cutoff score for reliable change (95%-criterion)
EMA_30.30
EMA_30.30$SEd_pre = sqrt(2 * (EMA_30.30$ind.pretestSD * sqrt(1 - EMA_5.5_Alpha)) ^ 2)
EMA_30.30$RCI_ind_preSD = (EMA_30.30$POST_Mean - EMA_30.30$PRE_Mean) / EMA_30.30$SEd_pre
EMA_30.30$RCI_ind_preSD_Cutoff = 1.96 * EMA_30.30$SEd_pre
# Sollen SEd_pre, RCI_ind_preSD und RCI_ind_preSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_30.30 = EMA_30.30 %>%
# within(., {SEd_pre[SEd_pre %in% c(-Inf,Inf)] = NA
# RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
# RCI_ind_preSD_Cutoff[RCI_ind_preSD_Cutoff %in% c(-Inf,Inf)] = NA})
scatter.hist(EMA_30.30$PRE_Mean, EMA_30.30$RCI_ind_preSD, xlab = "EMA_30.30$PRE_Mean", ylab = "EMA_30.30$RCI_ind_preSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in EMA_30.30 = 4.87.
Korrelation RCI(ind) nur mit Pre-SD (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.514.
EMA_5.5_Window
EMA_5.5_Window$SEd_pre = sqrt(2 * (EMA_5.5_Window$ind.pretestSD * sqrt(1 - EMA_5.5_Alpha)) ^ 2)
EMA_5.5_Window$RCI_ind_preSD = (EMA_5.5_Window$POST_Mean - EMA_5.5_Window$PRE_Mean) / EMA_5.5_Window$SEd_pre
EMA_5.5_Window$RCI_ind_preSD_Cutoff = 1.96 * EMA_5.5_Window$SEd_pre
# Sollen SEd_pre, RCI_ind_preSD und RCI_ind_preSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Window = EMA_5.5_Window %>%
# within(., {SEd_pre[SEd_pre %in% c(-Inf,Inf)] = NA
# RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
# RCI_ind_preSD_Cutoff[RCI_ind_preSD_Cutoff %in% c(-Inf,Inf)] = NA})
scatter.hist(EMA_5.5_Window$PRE_Mean, EMA_5.5_Window$RCI_ind_preSD, xlab = "EMA_5.5_Window$PRE_Mean", ylab = "EMA_5.5_Window$RCI_ind_preSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in EMA_5.5_Window = 5.009.
Korrelation RCI(ind) nur mit Pre-SD (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.488.
EMA_5.5_Days
EMA_5.5_Days$SEd_pre = sqrt(2 * (EMA_5.5_Days$ind.pretestSD * sqrt(1 - EMA_5.5_Alpha)) ^ 2)
EMA_5.5_Days$RCI_ind_preSD = (EMA_5.5_Days$POST_Mean - EMA_5.5_Days$PRE_Mean) / EMA_5.5_Days$SEd_pre
EMA_5.5_Days$RCI_ind_preSD_Cutoff = 1.96 * EMA_5.5_Days$SEd_pre
# Sollen SEd_pre, RCI_ind_preSD und RCI_ind_preSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Days = EMA_5.5_Days %>%
# within(., {SEd_pre[SEd_pre %in% c(-Inf,Inf)] = NA
# RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
# RCI_ind_preSD_Cutoff[RCI_ind_preSD_Cutoff %in% c(-Inf,Inf)] = NA})
scatter.hist(EMA_5.5_Days$PRE_Mean, EMA_5.5_Days$RCI_ind_preSD, xlab = "EMA_5.5_Days$PRE_Mean", ylab = "EMA_5.5_Days$RCI_ind_preSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in EMA_5.5_Days = 4.694.
Korrelation RCI(ind) nur mit Pre-SD (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.487.
\[
RCI_{ind} = \frac{\overline{x_{2}} - \overline{x_{1}}} {SE_{D}}
\]
\[ SE_{D} = \sqrt{(s_{x}^2 + s_{y}^2) \cdot (1 - r_{xy})} \]
\[ \text{significance cutoff} = 1.96 \cdot SE_{D} = 1.96 \cdot \sqrt{(s_{x}^2 + s_{y}^2) \cdot (1 - r_{xy})} \]
\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores, \(SE_{D}\) = pooled standard error of difference between the test scores \(s_{x}\) = individual standard deviation of pretest time points, \(s_{y}\) = individual standard deviation of pretest time points, \(r_{xy}\) = reliability (internal consistency Cronbach´s \(\alpha\)) of the measure, \(\text{significance cutoff}\) = (absolute) cutoff score for reliable change (95%-criterion)
EMA_30.30
EMA_30.30$SEd_pooled = sqrt((EMA_30.30$ind.pretestSD ^ 2 + EMA_30.30$ind.posttestSD ^ 2) * (1 - EMA_5.5_Alpha))
EMA_30.30$RCI_ind_pooledSD = (EMA_30.30$POST_Mean - EMA_30.30$PRE_Mean) / EMA_30.30$SEd_pooled
EMA_30.30$RCI_ind_pooledSD_Cutoff = 1.96 * EMA_30.30$SEd_pooled
# Sollen SEd_pooled, RCI_ind_pooledSD und RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_30.30 = EMA_30.30 %>%
# within(., {SEd_pooled[SEd_pooled %in% c(-Inf,Inf)] = NA
# RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA
# RCI_ind_pooledSD_Cutoff[RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf)] = NA})
scatter.hist(EMA_30.30$PRE_Mean, EMA_30.30$RCI_ind_pooledSD, xlab = "EMA_30.30$PRE_Mean", ylab = "EMA_30.30$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in EMA_30.30 = 5.681.
Korrelation RCI(ind) mit pooled SDs (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.481.
EMA_5.5_Window
EMA_5.5_Window$SEd_pooled = sqrt((EMA_5.5_Window$ind.pretestSD ^ 2 + EMA_5.5_Window$ind.posttestSD ^ 2) * (1 - EMA_5.5_Alpha))
EMA_5.5_Window$RCI_ind_pooledSD = (EMA_5.5_Window$POST_Mean - EMA_5.5_Window$PRE_Mean) / EMA_5.5_Window$SEd_pooled
EMA_5.5_Window$RCI_ind_pooledSD_Cutoff = 1.96 * EMA_5.5_Window$SEd_pooled
# Sollen SEd_pooled, RCI_ind_pooledSD und RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Window = EMA_5.5_Window %>%
# within(., {SEd_pooled[SEd_pooled %in% c(-Inf,Inf)] = NA
# RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA
# RCI_ind_pooledSD_Cutoff[RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf)] = NA})
scatter.hist(EMA_5.5_Window$PRE_Mean, EMA_5.5_Window$RCI_ind_pooledSD, xlab = "EMA_5.5_Window$PRE_Mean", ylab = "EMA_5.5_Window$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in EMA_5.5_Window = 5.866.
Korrelation RCI(ind) mit pooled SDs (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.469.
EMA_5.5_Days
EMA_5.5_Days$SEd_pooled = sqrt((EMA_5.5_Days$ind.pretestSD ^ 2 + EMA_5.5_Days$ind.posttestSD ^ 2) * (1 - EMA_5.5_Alpha))
EMA_5.5_Days$RCI_ind_pooledSD = (EMA_5.5_Days$POST_Mean - EMA_5.5_Days$PRE_Mean) / EMA_5.5_Days$SEd_pooled
EMA_5.5_Days$RCI_ind_pooledSD_Cutoff = 1.96 * EMA_5.5_Days$SEd_pooled
# Sollen SEd_pooled, RCI_ind_pooledSD und RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Days = EMA_5.5_Days %>%
# within(., {SEd_pooled[SEd_pooled %in% c(-Inf,Inf)] = NA
# RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA
# RCI_ind_pooledSD_Cutoff[RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf)] = NA})
scatter.hist(EMA_5.5_Days$PRE_Mean, EMA_5.5_Days$RCI_ind_pooledSD, xlab = "EMA_5.5_Days$PRE_Mean", ylab = "EMA_5.5_Days$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in EMA_5.5_Days = 5.544.
Korrelation RCI(ind) mit pooled SDs (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.476.
scatter.hist(EMA_30.30$RCI_ind_preSD, EMA_30.30$RCI_ind_pooledSD, xlab = "EMA_30.30$RCI_ind_preSD", ylab =
"EMA_30.30$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))
scatter.hist(EMA_5.5_Window$RCI_ind_preSD, EMA_5.5_Window$RCI_ind_pooledSD, xlab = "EMA_5.5_Window$RCI_ind_preSD", ylab =
"EMA_5.5_Window$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))
scatter.hist(EMA_5.5_Days$RCI_ind_preSD, EMA_5.5_Days$RCI_ind_pooledSD, xlab = "EMA_5.5_Days$RCI_ind_preSD", ylab =
"EMA_5.5_Days$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Clinically Significant Change im Sinne von Jacobson & Truax, also definiert durch einen RCI > |1.96| und die Überschreitung eines empirisch ermittelten Cutoff-Wertes, der die klinische von der gesunden Population von Testwerten trennt.
RCI_Int = tibble(RCI = c("Pre-Score >= 10 & Post-Score <= 9 & RCI < -1,96","every other combination",
"Pre-Score <= 9 & Post-Score >= 10 & RCI > 1,96"),
Klassifikation = c(-1,0,1),
Interpretation = c("reliable Verbesserung","keine reliable Veränderung","reliable Verschlechterung"))EMA_30.30: RCI(ind) nur mit Pre-SDs
EMA_30.30 = EMA_30.30 %>%
mutate(RCI_ind_preSD_klass = case_when(
#RCI_ind_preSD < -1.96 ~ -1,
#RCI_ind_preSD >= -1.96 & RCI_ind_preSD < 1.96 ~ 0,
#RCI_ind_preSD > 1.96 ~ 1,
#TRUE ~ RCI_ind_preSD
PRE_Mean >= 10 & POST_Mean <= 9 & RCI_ind_preSD < -1.96 ~ -1, #<------------- Cutoff-Kriterium hinzugefügt#
PRE_Mean <= 9 & POST_Mean >= 10 & RCI_ind_preSD > 1.96 ~ 1,
TRUE ~ 0
)
)
temp = EMA_30.30 %>%
count(RCI_ind_preSD_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
RCI_Int %>%
dplyr::rename(RCI_ind_preSD_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| RCI | RCI_ind_preSD_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| Pre-Score >= 10 & Post-Score <= 9 & RCI < -1,96 | -1 | reliable Verbesserung | 2041 | 25.39 |
| every other combination | 0 | keine reliable Veränderung | 5945 | 73.94 |
| Pre-Score <= 9 & Post-Score >= 10 & RCI > 1,96 | 1 | reliable Verschlechterung | 54 | 0.67 |
EMA_30.30: RCI(ind) mit pooled SDs
EMA_30.30 = EMA_30.30 %>%
mutate(RCI_ind_pooledSD_klass = case_when(
#RCI_ind_pooledSD < -1.96 ~ -1,
#RCI_ind_pooledSD >= -1.96 & RCI_ind_pooledSD < 1.96 ~ 0,
#RCI_ind_pooledSD > 1.96 ~ 1,
#TRUE ~ RCI_ind_pooledSD
PRE_Mean >= 10 & POST_Mean <= 9 & RCI_ind_pooledSD < -1.96 ~ -1, #<------------- Cutoff-Kriterium hinzugefügt#
PRE_Mean <= 9 & POST_Mean >= 10 & RCI_ind_pooledSD > 1.96 ~ 1,
TRUE ~ 0
)
)
temp = EMA_30.30 %>%
count(RCI_ind_pooledSD_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
RCI_Int %>%
dplyr::rename(RCI_ind_pooledSD_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| RCI | RCI_ind_pooledSD_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| Pre-Score >= 10 & Post-Score <= 9 & RCI < -1,96 | -1 | reliable Verbesserung | 1687 | 20.98 |
| every other combination | 0 | keine reliable Veränderung | 6340 | 78.86 |
| Pre-Score <= 9 & Post-Score >= 10 & RCI > 1,96 | 1 | reliable Verschlechterung | 13 | 0.16 |
EMA_5.5_Window: RCI(ind) nur mit Pre-SDs
EMA_5.5_Window = EMA_5.5_Window %>%
mutate(RCI_ind_preSD_klass = case_when(
#RCI_ind_preSD < -1.96 ~ -1,
#RCI_ind_preSD >= -1.96 & RCI_ind_preSD < 1.96 ~ 0,
#RCI_ind_preSD > 1.96 ~ 1,
#TRUE ~ RCI_ind_preSD
PRE_Mean >= 10 & POST_Mean <= 9 & RCI_ind_preSD < -1.96 ~ -1, #<------------- Cutoff-Kriterium hinzugefügt#
PRE_Mean <= 9 & POST_Mean >= 10 & RCI_ind_preSD > 1.96 ~ 1,
TRUE ~ 0
)
)
temp = EMA_5.5_Window %>%
count(RCI_ind_preSD_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
RCI_Int %>%
dplyr::rename(RCI_ind_preSD_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| RCI | RCI_ind_preSD_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| Pre-Score >= 10 & Post-Score <= 9 & RCI < -1,96 | -1 | reliable Verbesserung | 2054 | 25.55 |
| every other combination | 0 | keine reliable Veränderung | 5899 | 73.37 |
| Pre-Score <= 9 & Post-Score >= 10 & RCI > 1,96 | 1 | reliable Verschlechterung | 87 | 1.08 |
EMA_5.5_Window: RCI(ind) mit pooled SDs
EMA_5.5_Window = EMA_5.5_Window %>%
mutate(RCI_ind_pooledSD_klass = case_when(
#RCI_ind_pooledSD < -1.96 ~ -1,
#RCI_ind_pooledSD >= -1.96 & RCI_ind_pooledSD < 1.96 ~ 0,
#RCI_ind_pooledSD > 1.96 ~ 1,
#TRUE ~ RCI_ind_pooledSD
PRE_Mean >= 10 & POST_Mean <= 9 & RCI_ind_pooledSD < -1.96 ~ -1, #<------------- Cutoff-Kriterium hinzugefügt#
PRE_Mean <= 9 & POST_Mean >= 10 & RCI_ind_pooledSD > 1.96 ~ 1,
TRUE ~ 0
)
)
temp = EMA_5.5_Window %>%
count(RCI_ind_pooledSD_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
RCI_Int %>%
dplyr::rename(RCI_ind_pooledSD_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| RCI | RCI_ind_pooledSD_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| Pre-Score >= 10 & Post-Score <= 9 & RCI < -1,96 | -1 | reliable Verbesserung | 1750 | 21.77 |
| every other combination | 0 | keine reliable Veränderung | 6260 | 77.86 |
| Pre-Score <= 9 & Post-Score >= 10 & RCI > 1,96 | 1 | reliable Verschlechterung | 30 | 0.37 |
EMA_5.5_Days: RCI(ind) nur mit Pre-SDs
EMA_5.5_Days = EMA_5.5_Days %>%
mutate(RCI_ind_preSD_klass = case_when(
#RCI_ind_preSD < -1.96 ~ -1,
#RCI_ind_preSD >= -1.96 & RCI_ind_preSD < 1.96 ~ 0,
#RCI_ind_preSD > 1.96 ~ 1,
#TRUE ~ RCI_ind_preSD
PRE_Mean >= 10 & POST_Mean <= 9 & RCI_ind_preSD < -1.96 ~ -1, #<------------- Cutoff-Kriterium hinzugefügt#
PRE_Mean <= 9 & POST_Mean >= 10 & RCI_ind_preSD > 1.96 ~ 1,
TRUE ~ 0
)
)
temp = EMA_5.5_Days %>%
count(RCI_ind_preSD_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
RCI_Int %>%
dplyr::rename(RCI_ind_preSD_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| RCI | RCI_ind_preSD_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| Pre-Score >= 10 & Post-Score <= 9 & RCI < -1,96 | -1 | reliable Verbesserung | 2338 | 29.08 |
| every other combination | 0 | keine reliable Veränderung | 5550 | 69.03 |
| Pre-Score <= 9 & Post-Score >= 10 & RCI > 1,96 | 1 | reliable Verschlechterung | 152 | 1.89 |
EMA_5.5_Days: RCI(ind) mit pooled SDs
EMA_5.5_Days = EMA_5.5_Days %>%
mutate(RCI_ind_pooledSD_klass = case_when(
#RCI_ind_pooledSD < -1.96 ~ -1,
#RCI_ind_pooledSD >= -1.96 & RCI_ind_pooledSD < 1.96 ~ 0,
#RCI_ind_pooledSD > 1.96 ~ 1,
#TRUE ~ RCI_ind_pooledSD
PRE_Mean >= 10 & POST_Mean <= 9 & RCI_ind_pooledSD < -1.96 ~ -1, #<------------- Cutoff-Kriterium hinzugefügt#
PRE_Mean <= 9 & POST_Mean >= 10 & RCI_ind_pooledSD > 1.96 ~ 1,
TRUE ~ 0
)
)
temp = EMA_5.5_Days %>%
count(RCI_ind_pooledSD_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
RCI_Int %>%
dplyr::rename(RCI_ind_pooledSD_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| RCI | RCI_ind_pooledSD_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| Pre-Score >= 10 & Post-Score <= 9 & RCI < -1,96 | -1 | reliable Verbesserung | 2001 | 24.89 |
| every other combination | 0 | keine reliable Veränderung | 5965 | 74.19 |
| Pre-Score <= 9 & Post-Score >= 10 & RCI > 1,96 | 1 | reliable Verschlechterung | 74 | 0.92 |
\[
\bigl[ r_{xx} (X_{pre} - M_{pre}) + M_{pre} \bigr] \pm 2 \cdot S_{pre} \cdot \sqrt{1 - r_{xx}}
\]
\(r_{xx}\) = reliability of the measure, \(X_{pre}\) = individual´s raw score at pre-treatment, \(M_{pre}\) = mean of the sample at pre-treatment, \(S_{pre}\) = standard deviation of the sample at pre-treatment
Interpretation der Post-Ausprägung nach EN-Intervall-Methode
EN_Int = tibble(EN = c("PHQ POST < [EN-Intervall]","PHQ POST im [EN-Intervall]","PHQ POST > [EN-Intervall]"),
Klassifikation = c(-1,0,1), Interpretation = c("signifikante Verbesserung",
"keine signifikante Veränderung","signifikante Verschlechterung"))EN-Intervalle in EMA_30.30
EMA_30.30$EN_min = (EMA_5.5_Alpha * (EMA_30.30$PRE_Mean - mean(EMA_30.30$PRE_Mean)) + mean(EMA_30.30$PRE_Mean)) - 2 * mean(EMA_30.30$ind.pretestSD) * sqrt(1 - EMA_5.5_Alpha)
EMA_30.30$EN_max = (EMA_5.5_Alpha * (EMA_30.30$PRE_Mean - mean(EMA_30.30$PRE_Mean)) + mean(EMA_30.30$PRE_Mean)) + 2 * mean(EMA_30.30$ind.pretestSD) * sqrt(1 - EMA_5.5_Alpha)
EMA_30.30 = EMA_30.30 %>%
mutate(EN_klass = case_when(
POST_Mean > EN_max ~ 1,
POST_Mean <= EN_max & POST_Mean >= EN_min ~ 0,
POST_Mean < EN_min ~ -1,
TRUE ~ POST_Mean
)
)
temp = EMA_30.30 %>%
count(EN_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
EN_Int %>%
dplyr::rename(EN_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| EN | EN_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| PHQ POST < [EN-Intervall] | -1 | signifikante Verbesserung | 3730 | 46.39 |
| PHQ POST im [EN-Intervall] | 0 | keine signifikante Veränderung | 4293 | 53.40 |
| PHQ POST > [EN-Intervall] | 1 | signifikante Verschlechterung | 17 | 0.21 |
EN-Intervalle in EMA_5.5_Window
EMA_5.5_Window$EN_min = (EMA_5.5_Alpha * (EMA_5.5_Window$PRE_Mean - mean(EMA_5.5_Window$PRE_Mean)) +
mean(EMA_5.5_Window$PRE_Mean)) - 2 * mean(EMA_5.5_Window$ind.pretestSD) * sqrt(1 - EMA_5.5_Alpha)
EMA_5.5_Window$EN_max = (EMA_5.5_Alpha * (EMA_5.5_Window$PRE_Mean - mean(EMA_5.5_Window$PRE_Mean)) +
mean(EMA_5.5_Window$PRE_Mean)) + 2 * mean(EMA_5.5_Window$ind.pretestSD) * sqrt(1 - EMA_5.5_Alpha)
EMA_5.5_Window = EMA_5.5_Window %>%
mutate(EN_klass = case_when(
POST_Mean > EN_max ~ 1,
POST_Mean <= EN_max & POST_Mean >= EN_min ~ 0,
POST_Mean < EN_min ~ -1,
TRUE ~ POST_Mean
)
)
temp = EMA_5.5_Window %>%
count(EN_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
EN_Int %>%
dplyr::rename(EN_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| EN | EN_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| PHQ POST < [EN-Intervall] | -1 | signifikante Verbesserung | 3748 | 46.62 |
| PHQ POST im [EN-Intervall] | 0 | keine signifikante Veränderung | 4249 | 52.85 |
| PHQ POST > [EN-Intervall] | 1 | signifikante Verschlechterung | 43 | 0.53 |
EN-Intervalle in EMA_5.5_Days
EMA_5.5_Days$EN_min = (EMA_5.5_Alpha * (EMA_5.5_Days$PRE_Mean - mean(EMA_5.5_Days$PRE_Mean)) +
mean(EMA_5.5_Days$PRE_Mean)) - 2 * mean(EMA_5.5_Days$ind.pretestSD) * sqrt(1 - EMA_5.5_Alpha)
EMA_5.5_Days$EN_max = (EMA_5.5_Alpha * (EMA_5.5_Days$PRE_Mean - mean(EMA_5.5_Days$PRE_Mean)) +
mean(EMA_5.5_Days$PRE_Mean)) + 2 * mean(EMA_5.5_Days$ind.pretestSD) * sqrt(1 - EMA_5.5_Alpha)
EMA_5.5_Days = EMA_5.5_Days %>%
mutate(EN_klass = case_when(
POST_Mean > EN_max ~ 1,
POST_Mean <= EN_max & POST_Mean >= EN_min ~ 0,
POST_Mean < EN_min ~ -1,
TRUE ~ POST_Mean
)
)
temp = EMA_5.5_Days %>%
count(EN_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
EN_Int %>%
dplyr::rename(EN_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| EN | EN_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| PHQ POST < [EN-Intervall] | -1 | signifikante Verbesserung | 3993 | 49.66 |
| PHQ POST im [EN-Intervall] | 0 | keine signifikante Veränderung | 3906 | 48.58 |
| PHQ POST > [EN-Intervall] | 1 | signifikante Verschlechterung | 141 | 1.75 |
Clinically Significant Improvement (CSI) vom Pre- zum Post-Intervall
“The original validation study of the PHQ-9 defined clinically significant improvement as [a pre-treatment score >= 10 and] a post-treatment score of <= 9 combined with improvement of 50%.” (McMillan, Gilbody, & Richards, 2010)
CSI_Int = tibble(CSI = c("Pre-Score >= 10 & Post-Score <= 9 & PC >= 50", "every other combination",
"Pre-Score <= 9 & Post-Score >= 10 & PC <= -50"),
Klassifikation = c(-1,0,1),
Interpretation = c("klinisch signifikante Verbesserung", "keine klinisch signifikante Veränderung",
"klinisch signifikante Verschlechterung"))EMA_30.30 = EMA_30.30 %>%
mutate(CSI_klass = case_when(
PRE_Mean >= 10 & POST_Mean <= 9 & Mean_PC >= 50 ~ -1,
PRE_Mean <= 9 & POST_Mean >= 10 & Mean_PC <= -50 ~ 1,
TRUE ~ 0
)
)
temp = EMA_30.30 %>%
count(CSI_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
CSI_Int %>%
dplyr::rename(CSI_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| CSI | CSI_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| Pre-Score >= 10 & Post-Score <= 9 & PC >= 50 | -1 | klinisch signifikante Verbesserung | 1458 | 18.13 |
| every other combination | 0 | keine klinisch signifikante Veränderung | 6523 | 81.13 |
| Pre-Score <= 9 & Post-Score >= 10 & PC <= -50 | 1 | klinisch signifikante Verschlechterung | 59 | 0.73 |
EMA_5.5_Window = EMA_5.5_Window %>%
mutate(CSI_klass = case_when(
PRE_Mean >= 10 & POST_Mean <= 9 & Mean_PC >= 50 ~ -1,
PRE_Mean <= 9 & POST_Mean >= 10 & Mean_PC <= -50 ~ 1,
TRUE ~ 0
)
)
temp = EMA_5.5_Window %>%
count(CSI_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
CSI_Int %>%
dplyr::rename(CSI_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| CSI | CSI_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| Pre-Score >= 10 & Post-Score <= 9 & PC >= 50 | -1 | klinisch signifikante Verbesserung | 1582 | 19.68 |
| every other combination | 0 | keine klinisch signifikante Veränderung | 6359 | 79.09 |
| Pre-Score <= 9 & Post-Score >= 10 & PC <= -50 | 1 | klinisch signifikante Verschlechterung | 99 | 1.23 |
EMA_5.5_Days = EMA_5.5_Days %>%
mutate(CSI_klass = case_when(
PRE_Mean >= 10 & POST_Mean <= 9 & Mean_PC >= 50 ~ -1,
PRE_Mean <= 9 & POST_Mean >= 10 & Mean_PC <= -50 ~ 1,
TRUE ~ 0
)
)
temp = EMA_5.5_Days %>%
count(CSI_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
CSI_Int %>%
dplyr::rename(CSI_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| CSI | CSI_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| Pre-Score >= 10 & Post-Score <= 9 & PC >= 50 | -1 | klinisch signifikante Verbesserung | 1688 | 21.00 |
| every other combination | 0 | keine klinisch signifikante Veränderung | 6169 | 76.73 |
| Pre-Score <= 9 & Post-Score >= 10 & PC <= -50 | 1 | klinisch signifikante Verschlechterung | 183 | 2.28 |
# Speichern der Datasets inkl. aller Klassifikationsvariablen ----------- nötig?
EMA_30.30_final = EMA_30.30
EMA_5.5_Window_final = EMA_5.5_Window
EMA_5.5_Days_final = EMA_5.5_Days
save(EMA_30.30_final, file = "cor_04_k20/EMA_30.30_final.RData")#<<
save(EMA_5.5_Window_final, file = "cor_04_k20/EMA_5.5_Window_final.RData")#<<
save(EMA_5.5_Days_final, file = "cor_04_k20/EMA_5.5_Days_final.RData")#<<
# Für eine Tabelle der alleinigen Klassifikationen aus allen 3 Datensets im einheitlichen Format (-1,0,1)
# siehe die Erstellung von EMA_Class.RData unten.Übereinstimmung der Klassifikationen auf individueller Ebene zwischen EMA_30.30, EMA_5.5_Window und EMA_5.5_Days
Interpretation von Cohen´s Kappa:
tibble(Cohen_Kappa = c("k < .20",".21 <= k < .40",".41 <= k < .60",".61 <= k < .80","k > .80"),
Interpretation = c("poor","fair","moderate","good","very good")) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Cohen_Kappa | Interpretation |
|---|---|
| k < .20 | poor |
| .21 <= k < .40 | fair |
| .41 <= k < .60 | moderate |
| .61 <= k < .80 | good |
| k > .80 | very good |
Übereinstimmung zwischen den klinischen Interpretationen der PHQ-9-Werte für Pre- und Post-Intervalle (je 30 MZP und je 5 MZP):
# PRE
x = EMA_30.30 %>%
select(ID, PRE_Mean_klass) %>%
dplyr::rename(PRE_klass_30.30 = PRE_Mean_klass)
y = EMA_5.5_Window %>%
select(ID, PRE_Mean_klass) %>%
dplyr::rename(PRE_klass_5.5_Window = PRE_Mean_klass)
z = EMA_5.5_Days %>%
select(ID, PRE_Mean_klass) %>%
dplyr::rename(PRE_klass_5.5_Days = PRE_Mean_klass)
temp = full_join(x, y, by = "ID") %>%
full_join(., z, by = "ID") %>%
select(-ID) %>%
mutate(across(.cols = everything(), as.factor))
### Cohen´s Kappa
rnames = c("PRE_klass_30.30", "PRE_klass_5.5_Window", "PRE_klass_5.5_Days")
Agreement = matrix(ncol = 3, nrow = 3, dimnames = list(rnames, rnames))
for (i in 1:nrow(Agreement)) {
for (j in 1:ncol(Agreement)) {
x = eval(parse(text = paste0("temp$", names(temp[,i]))))
y = eval(parse(text = paste0("temp$", names(temp[,j]))))
Agreement[i,j] = CohenKappa(x = x, y = y)
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.7, cex = 0.8, las = 2,
key = list(cex.axis=0.7), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
title(main = "Übereinstimmung (Cohen´s Kappa) der PHQ-PRE-Klassifikationen")# POST
x = EMA_30.30 %>%
select(ID, POST_Mean_klass) %>%
dplyr::rename(POST_klass_30.30 = POST_Mean_klass)
y = EMA_5.5_Window %>%
select(ID, POST_Mean_klass) %>%
dplyr::rename(POST_klass_5.5_Window = POST_Mean_klass)
z = EMA_5.5_Days %>%
select(ID, POST_Mean_klass) %>%
dplyr::rename(POST_klass_5.5_Days = POST_Mean_klass)
temp = full_join(x, y, by = "ID") %>%
full_join(., z, by = "ID") %>%
select(-ID) %>%
mutate(across(.cols = everything(), as.factor))
### Cohen´s Kappa
rnames = c("POST_klass_30.30", "POST_klass_5.5_Window", "POST_klass_5.5_Days")
Agreement = matrix(ncol = 3, nrow = 3, dimnames = list(rnames, rnames))
for (i in 1:nrow(Agreement)) {
for (j in 1:ncol(Agreement)) {
x = eval(parse(text = paste0("temp$", names(temp[,i]))))
y = eval(parse(text = paste0("temp$", names(temp[,j]))))
Agreement[i,j] = CohenKappa(x = x, y = y)
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.7, cex = 0.8, las = 2,
key = list(cex.axis=0.7), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
title(main = "Übereinstimmung (Cohen´s Kappa) der PHQ-POST-Klassifikationen")# einheitliche Kodierung von Verbesserung (-1), keiner Veränderung (0) und Verschlechterung (1):
x = EMA_30.30 %>%
select(ID, Mean_PC_klass, RCI_ind_preSD_klass, RCI_ind_pooledSD_klass, EN_klass, CSI_klass) %>%
dplyr::rename(Mean_PC_30.30 = Mean_PC_klass, RCI_ind_preSD_30.30 = RCI_ind_preSD_klass,
RCI_ind_pooledSD_30.30 = RCI_ind_pooledSD_klass, EN_30.30 = EN_klass, CSI_30.30 = CSI_klass) %>%
mutate(Mean_PC_30.30 = recode(Mean_PC_30.30, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))
y = EMA_5.5_Window %>%
select(ID, Mean_PC_klass, RCI_ind_preSD_klass, RCI_ind_pooledSD_klass, EN_klass, CSI_klass) %>%
dplyr::rename(Mean_PC_5.5_Window = Mean_PC_klass, RCI_ind_preSD_5.5_Window = RCI_ind_preSD_klass,
RCI_ind_pooledSD_5.5_Window = RCI_ind_pooledSD_klass, EN_5.5_Window = EN_klass, CSI_5.5_Window = CSI_klass) %>%
mutate(Mean_PC_5.5_Window = recode(Mean_PC_5.5_Window, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))
z = EMA_5.5_Days %>%
select(ID, Mean_PC_klass, RCI_ind_preSD_klass, RCI_ind_pooledSD_klass, EN_klass, CSI_klass) %>%
dplyr::rename(Mean_PC_5.5_Days = Mean_PC_klass, RCI_ind_preSD_5.5_Days = RCI_ind_preSD_klass,
RCI_ind_pooledSD_5.5_Days = RCI_ind_pooledSD_klass, EN_5.5_Days = EN_klass, CSI_5.5_Days = CSI_klass) %>%
mutate(Mean_PC_5.5_Days = recode(Mean_PC_5.5_Days, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))
EMA_Class = full_join(x, y, by = "ID") %>%
full_join(., z, "ID") %>%
select(-ID) %>%
dplyr::mutate(across(.cols = everything(), as.factor))
#save(EMA_Class, file = "cor_04_k20/EMA_Class.RData")
rnames = names(EMA_Class)
#view(dfSummary(EMA_Class))
#dfSummary(EMA_Class, plain.ascii = FALSE, style = 'grid', graph.magnif = 0.75, valid.col = FALSE, tmp.img.dir = "/tmp")
#dfSummary(EMA_Class)
print(dfSummary(EMA_Class, varnumbers = FALSE, plain.ascii = FALSE, style = 'grid', graph.magnif = 0.75, valid.col = FALSE, na.col = FALSE, display.labels = FALSE, silent = FALSE, headers = FALSE, footnote = NA, tmp.img.dir = "/tmp"), method = 'render')| Variable | Stats / Values | Freqs (% of Valid) | Graph | ||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Mean_PC_30.30 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| RCI_ind_preSD_30.30 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| RCI_ind_pooledSD_30.30 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| EN_30.30 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| CSI_30.30 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| Mean_PC_5.5_Window [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| RCI_ind_preSD_5.5_Window [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| RCI_ind_pooledSD_5.5_Window [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| EN_5.5_Window [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| CSI_5.5_Window [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| Mean_PC_5.5_Days [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| RCI_ind_preSD_5.5_Days [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| RCI_ind_pooledSD_5.5_Days [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| EN_5.5_Days [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| CSI_5.5_Days [factor] | 1. -1 2. 0 3. 1 |
|
Generated by summarytools 0.9.8 (R version 4.0.2)
2021-08-20
Gesamt-Übereinstimmung
### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))
for (i in 1:nrow(Agreement)) {
for (j in 1:ncol(Agreement)) {
x = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,i]))))
y = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,j]))))
Agreement[i,j] = CohenKappa(x = x, y = y)
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2,
key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
title(main = "Übereinstimmung (Cohen´s Kappa) der Klassifikationen")### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))
for (i in 1:nrow(Percentage_Agreement)) {
for (j in 1:ncol(Percentage_Agreement)) {
x = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,i]))))
y = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,j]))))
Percentage_Agreement[i,j] = Agree(cbind(x, y))[1]
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2,
key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
title(main = "Prozentuale Übereinstimmung der Klassifikationen")Übereinstimmung nur für Verbesserung (-1)
### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))
for (i in 1:nrow(Agreement)) {
for (j in 1:ncol(Agreement)) {
x = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,i])))) %>%
dplyr::recode_factor(., '-1' = -1L)
y = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,j])))) %>%
dplyr::recode_factor(., '-1' = -1L)
Agreement[i,j] = CohenKappa(x = x, y = y, useNA = "ifany")
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2,
key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
title(main = "Übereinstimmung (Cohen´s Kappa): Verbesserung (-1)")### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))
for (i in 1:nrow(Percentage_Agreement)) {
for (j in 1:ncol(Percentage_Agreement)) {
x = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,i]))))
y = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,j]))))
Percentage_Agreement[i,j] = length(which(x == -1L & y == -1L)) /
length(which(x == -1L | y == -1L))
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2,
key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
title(main = "Prozentuale Übereinstimmung: Verbesserung (-1)")Übereinstimmung nur für Verschlechterung (1)
### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))
for (i in 1:nrow(Agreement)) {
for (j in 1:ncol(Agreement)) {
x = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,i])))) %>%
recode_factor(., '1' = 1L)
y = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,j])))) %>%
recode_factor(., '1' = 1L)
Agreement[i,j] = CohenKappa(x = x, y = y, useNA = "ifany")
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2,
key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
title(main = "Übereinstimmung (Cohen´s Kappa): Verschlechterung (1)")### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))
for (i in 1:nrow(Percentage_Agreement)) {
for (j in 1:ncol(Percentage_Agreement)) {
x = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,i]))))
y = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,j]))))
Percentage_Agreement[i,j] = length(which(x == 1L & y == 1L)) /
length(which(x == 1L | y == 1L))
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2,
key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
title(main = "Prozentuale Übereinstimmung: Verschlechterung (1)")Diagnostische Sensitivität und Spezifität einer “neuen” Testmethode im Vergleich zu einer “Goldstandard”-Testmethode:
Sensitivität = Wahrscheinlichkeit für ein richtig-positives Testergebnis
Spezifität = Wahrscheinlichkeit für ein richtig-negatives Testergebnis
\[ Sensitivity = Recall = TPR = \frac{\sum{\text{True Positives}}} {\sum{\text{True Positives}} + \sum{\text{False Negatives}}} = \frac{tp}{tp + fn} \]
\[ Specificity = Selectivity = TNR = \frac{\sum{\text{True Negatives}}} {\sum{\text{True Negatives}} + \sum{\text{False Positives}}} = \frac{tn}{tn + fp} \]
\[ \textit{Geometric Mean of Sensitivity and Specificity} = \sqrt{Sensitivity \cdot Specificity} \]
\[ Sensitivity_{\textit{class-weighted average}} = Recall_{wgt} = \rho_{wgt} = \sum_{k=1}^{c} \frac{n_k}{n} \rho_k = \frac{1}{n} \sum_{k=1}^{c} tp^{(k)} = \frac{tp^{(deteriorated)}} {tp^{(deteriorated)} + fn^{(deteriorated)}} + \frac{tp^{(\textit{not changed})}} {tp^{(\textit{not changed})} + fn^{(\textit{not changed})}} + \frac{tp^{(improved)}} {tp^{(improved)} + fn^{(improved)}} \]
\(c\) = number of classes (i.e. 3: deteriorated; not changed; improved); \(n_k\) = number of cases belonging to class \(k\), with \(k=1,...,c\); \(n\) = total number of cases, with \(n = \sum_{k=1}^{c} n_k\)
Sensitivität & Spezifität gegenüber Veränderung:
Evaluation der Veränderungs-Klassifikationen der Klassifikationsmethoden im Vergleich zur klinischen Signifikanz CSI (je 30 MZP) als “Goldstandard”:
ClassEval = list()
for (i in 1:ncol(EMA_Class)) {
x = eval(parse(text = paste0("EMA_Class$", colnames(EMA_Class[,i]))))
cm = confusionMatrix(x, reference = EMA_Class$CSI_30.30,
dnn = c(paste0("EMA_Class$", names(EMA_Class[,i])), "CSI 30.30"), mode = "everything")
cm$agreement = cm$overall[c("Accuracy","Kappa")]
cm$senspez = cm$byClass %>%
as_tibble() %>%
select(Sensitivity, Specificity)
cm$senspez_cwa = cm$senspez %>%
summarise(across(.cols = everything(), .fns = geometric.mean, .names = "{.col}_cwa")) %>%
mutate(GMean_SenSpez = geometric.mean(c(Sensitivity_cwa, Specificity_cwa)))
ClassEval[[paste0(names(EMA_Class[,i]))]] = cm[c("table","agreement","senspez","senspez_cwa")]
}
#save(ClassEval, file = "cor_04_k20/EMA_ClassEval.RData")
#load("cor_04_k20/EMA_Class.RData")
SenSpezSumm = tibble(Frequency = as.factor(c(rep("30.30", 5), rep("5.5", 10))),
Method = colnames(EMA_Class),
Sens_imp = as.numeric(NA),
Sens_not = as.numeric(NA),
Sens_det = as.numeric(NA),
Spec_imp = as.numeric(NA),
Spec_not = as.numeric(NA),
Spec_det = as.numeric(NA),
Sensitivity_cwa = as.numeric(NA),
Specificity_cwa = as.numeric(NA),
SenSpec_mean = as.numeric(NA),
Accuracy_PercAgree = as.numeric(NA),
Kappa = as.numeric(NA))
for (i in 1:nrow(SenSpezSumm)) {
SenSpezSumm[i,"Sens_imp"] = ClassEval[[i]][["senspez"]]$Sensitivity[1]
SenSpezSumm[i,"Sens_not"] = ClassEval[[i]][["senspez"]]$Sensitivity[2]
SenSpezSumm[i,"Sens_det"] = ClassEval[[i]][["senspez"]]$Sensitivity[3]
SenSpezSumm[i,"Spec_imp"] = ClassEval[[i]][["senspez"]]$Specificity[1]
SenSpezSumm[i,"Spec_not"] = ClassEval[[i]][["senspez"]]$Specificity[2]
SenSpezSumm[i,"Spec_det"] = ClassEval[[i]][["senspez"]]$Specificity[3]
SenSpezSumm[i,"Sensitivity_cwa"] = ClassEval[[i]][["senspez_cwa"]]$Sensitivity_cwa
SenSpezSumm[i,"Specificity_cwa"] = ClassEval[[i]][["senspez_cwa"]]$Specificity_cwa
SenSpezSumm[i,"SenSpec_mean"] = ClassEval[[i]][["senspez_cwa"]]$GMean_SenSpez
SenSpezSumm[i,"Accuracy_PercAgree"] = ClassEval[[i]][["agreement"]][[1]]
SenSpezSumm[i,"Kappa"] = ClassEval[[i]][["agreement"]][[2]]
}
#save(SenSpezSumm, file = "cor_04_k20/EMA_SenSpezSumm.RData")
#load("cor_04_k20/EMA_SenSpezSumm.RData")
SenSpezSumm %>%
mutate(across(.cols = where(is.numeric), .fns = round, digits = 2)) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Frequency | Method | Sens_imp | Sens_not | Sens_det | Spec_imp | Spec_not | Spec_det | Sensitivity_cwa | Specificity_cwa | SenSpec_mean | Accuracy_PercAgree | Kappa |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 30.30 | Mean_PC_30.30 | 1.00 | 0.93 | 1.00 | 0.93 | 1.00 | 1.00 | 0.98 | 0.98 | 0.98 | 0.94 | 0.84 |
| 30.30 | RCI_ind_preSD_30.30 | 0.84 | 0.87 | 0.47 | 0.88 | 0.83 | 1.00 | 0.70 | 0.90 | 0.79 | 0.86 | 0.61 |
| 30.30 | RCI_ind_pooledSD_30.30 | 0.88 | 0.94 | 0.17 | 0.94 | 0.85 | 1.00 | 0.52 | 0.93 | 0.69 | 0.92 | 0.75 |
| 30.30 | EN_30.30 | 1.00 | 0.65 | 0.25 | 0.65 | 0.97 | 1.00 | 0.55 | 0.86 | 0.69 | 0.71 | 0.40 |
| 30.30 | CSI_30.30 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 |
| 5.5 | Mean_PC_5.5_Window | 0.86 | 0.86 | 0.69 | 0.88 | 0.85 | 0.99 | 0.80 | 0.90 | 0.85 | 0.86 | 0.62 |
| 5.5 | RCI_ind_preSD_5.5_Window | 0.74 | 0.84 | 0.49 | 0.85 | 0.73 | 0.99 | 0.67 | 0.85 | 0.76 | 0.82 | 0.50 |
| 5.5 | RCI_ind_pooledSD_5.5_Window | 0.76 | 0.90 | 0.15 | 0.90 | 0.74 | 1.00 | 0.47 | 0.87 | 0.64 | 0.87 | 0.60 |
| 5.5 | EN_5.5_Window | 0.98 | 0.64 | 0.20 | 0.65 | 0.95 | 1.00 | 0.50 | 0.85 | 0.65 | 0.70 | 0.38 |
| 5.5 | CSI_5.5_Window | 0.81 | 0.93 | 0.69 | 0.94 | 0.80 | 0.99 | 0.80 | 0.91 | 0.85 | 0.91 | 0.71 |
| 5.5 | Mean_PC_5.5_Days | 0.83 | 0.81 | 0.81 | 0.84 | 0.83 | 0.98 | 0.82 | 0.88 | 0.85 | 0.82 | 0.53 |
| 5.5 | RCI_ind_preSD_5.5_Days | 0.76 | 0.79 | 0.56 | 0.81 | 0.75 | 0.99 | 0.70 | 0.84 | 0.77 | 0.78 | 0.44 |
| 5.5 | RCI_ind_pooledSD_5.5_Days | 0.76 | 0.86 | 0.37 | 0.86 | 0.75 | 0.99 | 0.62 | 0.86 | 0.73 | 0.84 | 0.53 |
| 5.5 | EN_5.5_Days | 0.97 | 0.59 | 0.53 | 0.61 | 0.95 | 0.99 | 0.67 | 0.83 | 0.75 | 0.66 | 0.34 |
| 5.5 | CSI_5.5_Days | 0.77 | 0.89 | 0.75 | 0.91 | 0.76 | 0.98 | 0.80 | 0.88 | 0.84 | 0.87 | 0.61 |
SenSpezSumm %>%
ggplot(aes(x = Method, weight = Sensitivity_cwa)) +
geom_bar(fill = "#0c4c8a") +
coord_flip() +
theme_bw() +
labs(y = "Sensitivity to Change (Reference = CSI_30.30)")#<<
#ggsave("Plots/k20_EMA_Sensitivity_Barplot.jpg", width = 6, height = 4)#<<
SenSpezSumm %>%
ggplot(aes(x = Method, weight = Specificity_cwa)) +
geom_bar(fill = "#0c4c8a") +
coord_flip() +
theme_bw() +
labs(y = "Specificity to Change (Reference = CSI_30.30)")#<<
#ggsave("Plots/k20_EMA_Specificity_Barplot.jpg", width = 6, height = 4)#<<
SenSpezSumm %>%
ggplot(aes(x = Method, weight = SenSpec_mean)) +
geom_bar(fill = "#0c4c8a") +
coord_flip() +
theme_bw() +
labs(y = "Mean of Sensitivity and Specificity (Reference = CSI_30.30)")#<<
#ggsave("Plots/k20_EMA_SenSpec-Mean_Barplot.jpg", width = 6, height = 4)#<<
SenSpezSumm %>%
ggplot(aes(x = Method, weight = Accuracy_PercAgree)) +
geom_bar(fill = "#0c4c8a") +
coord_flip() +
theme_bw() +
labs(y = "Accuracy = Percentage Agreement (Reference = CSI_30.30)")#<<
#ggsave("Plots/k20_EMA_PercAgree_Barplot.jpg", width = 6, height = 4)#<<
SenSpezSumm %>%
ggplot(aes(x = Method, weight = Kappa)) +
geom_bar(fill = "#0c4c8a") +
coord_flip() +
theme_bw() +
labs(y = "Agreement: Cohen´s Kappa (Reference = CSI_30.30)")#<<
#ggsave("Plots/k20_EMA_Kappa_Barplot.jpg", width = 6, height = 4)#<<
df = SenSpezSumm %>%
pivot_longer(cols = Sens_imp:Kappa, names_to = "Index", values_to = "Estimate") %>%
mutate(Method = as_factor(Method), Index = as_factor(Index))#<<
#ggplot(df) +
# aes(x = Method, colour = Index, weight = Estimate) +
# geom_bar(position = "dodge", fill = "#0c4c8a") +
# scale_color_hue() +
# theme_gray()#<<
#ggsave("Plots/k20_EMA_Class_Evaluation_by_Methods.jpg", width = 6, height = 4)#<<Sensitivität & Spezifität gegenüber Veränderung:
Evaluation der Veränderungs-Klassifikationen der Klassifikationsmethoden within-method, between-frequencies, jeweils mit den Klassifikationen der Methode im 30-MZP-Szenario als Referenz:
#load("cor_04_k20/EMA_Class.RData")
########## Agreement between Mean PCs in 30-fold, 5-fold Random Window and 5-fold Random Days assessment frequencies
EMA_Class_PC = EMA_Class %>% select(Mean_PC_30.30,Mean_PC_5.5_Window,Mean_PC_5.5_Days)
ClassEval_PC = list()
for (i in 1:ncol(EMA_Class_PC)) {
x = eval(parse(text = paste0("EMA_Class_PC$", colnames(EMA_Class_PC[,i]))))
cm = confusionMatrix(x, reference = EMA_Class_PC$Mean_PC_30.30,
dnn = c(paste0("EMA_Class_PC$", names(EMA_Class_PC[,i])), "Mean PC 30.30"), mode = "everything")
cm$agreement = cm$overall[c("Accuracy","Kappa")]
cm$senspez = cm$byClass %>%
as_tibble() %>%
select(Sensitivity, Specificity)
cm$senspez_cwa = cm$senspez %>%
summarise(across(.cols = everything(), .fns = geometric.mean, .names = "{.col}_cwa")) %>%
mutate(GMean_SenSpez = geometric.mean(c(Sensitivity_cwa, Specificity_cwa)))
ClassEval_PC[[paste0(names(EMA_Class_PC[,i]))]] = cm[c("table","agreement","senspez","senspez_cwa")]
}
#save(ClassEval_PC, file = "cor_04_k20/EMA_ClassEval_PC.RData")
#load("cor_04_k20/EMA_ClassEval_PC.RData")
SenSpezSumm_PC = tibble(Frequency = as.factor(c("30.30","5.5 Window","5.5 Days")),
Method = colnames(EMA_Class_PC),
Sens_imp = as.numeric(NA),
Sens_not = as.numeric(NA),
Sens_det = as.numeric(NA),
Spec_imp = as.numeric(NA),
Spec_not = as.numeric(NA),
Spec_det = as.numeric(NA),
Sensitivity_cwa = as.numeric(NA),
Specificity_cwa = as.numeric(NA),
SenSpec_mean = as.numeric(NA),
Accuracy_PercAgree = as.numeric(NA),
Kappa = as.numeric(NA))
for (i in 1:nrow(SenSpezSumm_PC)) {
SenSpezSumm_PC[i,"Sens_imp"] = ClassEval_PC[[i]][["senspez"]]$Sensitivity[1]
SenSpezSumm_PC[i,"Sens_not"] = ClassEval_PC[[i]][["senspez"]]$Sensitivity[2]
SenSpezSumm_PC[i,"Sens_det"] = ClassEval_PC[[i]][["senspez"]]$Sensitivity[3]
SenSpezSumm_PC[i,"Spec_imp"] = ClassEval_PC[[i]][["senspez"]]$Specificity[1]
SenSpezSumm_PC[i,"Spec_not"] = ClassEval_PC[[i]][["senspez"]]$Specificity[2]
SenSpezSumm_PC[i,"Spec_det"] = ClassEval_PC[[i]][["senspez"]]$Specificity[3]
SenSpezSumm_PC[i,"Sensitivity_cwa"] = ClassEval_PC[[i]][["senspez_cwa"]]$Sensitivity_cwa
SenSpezSumm_PC[i,"Specificity_cwa"] = ClassEval_PC[[i]][["senspez_cwa"]]$Specificity_cwa
SenSpezSumm_PC[i,"SenSpec_mean"] = ClassEval_PC[[i]][["senspez_cwa"]]$GMean_SenSpez
SenSpezSumm_PC[i,"Accuracy_PercAgree"] = ClassEval_PC[[i]][["agreement"]][[1]]
SenSpezSumm_PC[i,"Kappa"] = ClassEval_PC[[i]][["agreement"]][[2]]
}
#save(SenSpezSumm_PC, file = "cor_04_k20/EMA_SenSpezSumm_PC.RData")
#load("cor_04_k20/EMA_SenSpezSumm_PC.RData")
SenSpezSumm_PC %>%
mutate(across(.cols = where(is.numeric), .fns = round, digits = 2)) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Frequency | Method | Sens_imp | Sens_not | Sens_det | Spec_imp | Spec_not | Spec_det | Sensitivity_cwa | Specificity_cwa | SenSpec_mean | Accuracy_PercAgree | Kappa |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 30.30 | Mean_PC_30.30 | 1.00 | 1.00 | 1.0 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 |
| 5.5 Window | Mean_PC_5.5_Window | 0.86 | 0.92 | 0.7 | 0.93 | 0.85 | 0.99 | 0.82 | 0.92 | 0.87 | 0.90 | 0.74 |
| 5.5 Days | Mean_PC_5.5_Days | 0.83 | 0.86 | 0.7 | 0.89 | 0.83 | 0.98 | 0.79 | 0.90 | 0.84 | 0.85 | 0.64 |
########## Agreement between CSI(PC)s in 30-fold, 5-fold Random Window and 5-fold Random Days assessment frequencies
EMA_Class_CSI = EMA_Class %>% select(CSI_30.30,CSI_5.5_Window,CSI_5.5_Days)
ClassEval_CSI = list()
for (i in 1:ncol(EMA_Class_CSI)) {
x = eval(parse(text = paste0("EMA_Class_CSI$", colnames(EMA_Class_CSI[,i]))))
cm = confusionMatrix(x, reference = EMA_Class_CSI$CSI_30.30,
dnn = c(paste0("EMA_Class_CSI$", names(EMA_Class_CSI[,i])), "CSI Mean PC 30.30"), mode = "everything")
cm$agreement = cm$overall[c("Accuracy","Kappa")]
cm$senspez = cm$byClass %>%
as_tibble() %>%
select(Sensitivity, Specificity)
cm$senspez_cwa = cm$senspez %>%
summarise(across(.cols = everything(), .fns = geometric.mean, .names = "{.col}_cwa")) %>%
mutate(GMean_SenSpez = geometric.mean(c(Sensitivity_cwa, Specificity_cwa)))
ClassEval_CSI[[paste0(names(EMA_Class_CSI[,i]))]] = cm[c("table","agreement","senspez","senspez_cwa")]
}
#save(ClassEval_CSI, file = "cor_04_k20/EMA_ClassEval_CSI.RData")
#load("cor_04_k20/EMA_ClassEval_CSI.RData")
SenSpezSumm_CSI = tibble(Frequency = as.factor(c("30.30","5.5 Window","5.5 Days")),
Method = colnames(EMA_Class_CSI),
Sens_imp = as.numeric(NA),
Sens_not = as.numeric(NA),
Sens_det = as.numeric(NA),
Spec_imp = as.numeric(NA),
Spec_not = as.numeric(NA),
Spec_det = as.numeric(NA),
Sensitivity_cwa = as.numeric(NA),
Specificity_cwa = as.numeric(NA),
SenSpec_mean = as.numeric(NA),
Accuracy_PercAgree = as.numeric(NA),
Kappa = as.numeric(NA))
for (i in 1:nrow(SenSpezSumm_CSI)) {
SenSpezSumm_CSI[i,"Sens_imp"] = ClassEval_CSI[[i]][["senspez"]]$Sensitivity[1]
SenSpezSumm_CSI[i,"Sens_not"] = ClassEval_CSI[[i]][["senspez"]]$Sensitivity[2]
SenSpezSumm_CSI[i,"Sens_det"] = ClassEval_CSI[[i]][["senspez"]]$Sensitivity[3]
SenSpezSumm_CSI[i,"Spec_imp"] = ClassEval_CSI[[i]][["senspez"]]$Specificity[1]
SenSpezSumm_CSI[i,"Spec_not"] = ClassEval_CSI[[i]][["senspez"]]$Specificity[2]
SenSpezSumm_CSI[i,"Spec_det"] = ClassEval_CSI[[i]][["senspez"]]$Specificity[3]
SenSpezSumm_CSI[i,"Sensitivity_cwa"] = ClassEval_CSI[[i]][["senspez_cwa"]]$Sensitivity_cwa
SenSpezSumm_CSI[i,"Specificity_cwa"] = ClassEval_CSI[[i]][["senspez_cwa"]]$Specificity_cwa
SenSpezSumm_CSI[i,"SenSpec_mean"] = ClassEval_CSI[[i]][["senspez_cwa"]]$GMean_SenSpez
SenSpezSumm_CSI[i,"Accuracy_PercAgree"] = ClassEval_CSI[[i]][["agreement"]][[1]]
SenSpezSumm_CSI[i,"Kappa"] = ClassEval_CSI[[i]][["agreement"]][[2]]
}
#save(SenSpezSumm_CSI, file = "cor_04_k20/EMA_SenSpezSumm_CSI.RData")
#load("cor_04_k20/EMA_SenSpezSumm_CSI.RData")
SenSpezSumm_CSI %>%
mutate(across(.cols = where(is.numeric), .fns = round, digits = 2)) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Frequency | Method | Sens_imp | Sens_not | Sens_det | Spec_imp | Spec_not | Spec_det | Sensitivity_cwa | Specificity_cwa | SenSpec_mean | Accuracy_PercAgree | Kappa |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 30.30 | CSI_30.30 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.0 | 1.00 | 1.00 | 1.00 | 1.00 |
| 5.5 Window | CSI_5.5_Window | 0.81 | 0.93 | 0.69 | 0.94 | 0.80 | 0.99 | 0.8 | 0.91 | 0.85 | 0.91 | 0.71 |
| 5.5 Days | CSI_5.5_Days | 0.77 | 0.89 | 0.75 | 0.91 | 0.76 | 0.98 | 0.8 | 0.88 | 0.84 | 0.87 | 0.61 |
########## Agreement between RCIs (ind.) in 30-fold, 5-fold Random Window and 5-fold Random Days assessment frequencies
EMA_Class_RCI = EMA_Class %>% select(RCI_ind_preSD_30.30,RCI_ind_preSD_5.5_Window,RCI_ind_preSD_5.5_Days)
ClassEval_RCI = list()
for (i in 1:ncol(EMA_Class_RCI)) {
x = eval(parse(text = paste0("EMA_Class_RCI$", colnames(EMA_Class_RCI[,i]))))
cm = confusionMatrix(x, reference = EMA_Class_RCI$RCI_ind_preSD_30.30,
dnn = c(paste0("EMA_Class_RCI$", names(EMA_Class_RCI[,i])), "RCI ind pre-SD 30.30"), mode = "everything")
cm$agreement = cm$overall[c("Accuracy","Kappa")]
cm$senspez = cm$byClass %>%
as_tibble() %>%
select(Sensitivity, Specificity)
cm$senspez_cwa = cm$senspez %>%
summarise(across(.cols = everything(), .fns = geometric.mean, .names = "{.col}_cwa")) %>%
mutate(GMean_SenSpez = geometric.mean(c(Sensitivity_cwa, Specificity_cwa)))
ClassEval_RCI[[paste0(names(EMA_Class_RCI[,i]))]] = cm[c("table","agreement","senspez","senspez_cwa")]
}
#save(ClassEval_RCI, file = "cor_04_k20/EMA_ClassEval_RCI.RData")
#load("cor_04_k20/EMA_ClassEval_RCI.RData")
SenSpezSumm_RCI = tibble(Frequency = as.factor(c("30.30","5.5 Window","5.5 Days")),
Method = colnames(EMA_Class_RCI),
Sens_imp = as.numeric(NA),
Sens_not = as.numeric(NA),
Sens_det = as.numeric(NA),
Spec_imp = as.numeric(NA),
Spec_not = as.numeric(NA),
Spec_det = as.numeric(NA),
Sensitivity_cwa = as.numeric(NA),
Specificity_cwa = as.numeric(NA),
SenSpec_mean = as.numeric(NA),
Accuracy_PercAgree = as.numeric(NA),
Kappa = as.numeric(NA))
for (i in 1:nrow(SenSpezSumm_RCI)) {
SenSpezSumm_RCI[i,"Sens_imp"] = ClassEval_RCI[[i]][["senspez"]]$Sensitivity[1]
SenSpezSumm_RCI[i,"Sens_not"] = ClassEval_RCI[[i]][["senspez"]]$Sensitivity[2]
SenSpezSumm_RCI[i,"Sens_det"] = ClassEval_RCI[[i]][["senspez"]]$Sensitivity[3]
SenSpezSumm_RCI[i,"Spec_imp"] = ClassEval_RCI[[i]][["senspez"]]$Specificity[1]
SenSpezSumm_RCI[i,"Spec_not"] = ClassEval_RCI[[i]][["senspez"]]$Specificity[2]
SenSpezSumm_RCI[i,"Spec_det"] = ClassEval_RCI[[i]][["senspez"]]$Specificity[3]
SenSpezSumm_RCI[i,"Sensitivity_cwa"] = ClassEval_RCI[[i]][["senspez_cwa"]]$Sensitivity_cwa
SenSpezSumm_RCI[i,"Specificity_cwa"] = ClassEval_RCI[[i]][["senspez_cwa"]]$Specificity_cwa
SenSpezSumm_RCI[i,"SenSpec_mean"] = ClassEval_RCI[[i]][["senspez_cwa"]]$GMean_SenSpez
SenSpezSumm_RCI[i,"Accuracy_PercAgree"] = ClassEval_RCI[[i]][["agreement"]][[1]]
SenSpezSumm_RCI[i,"Kappa"] = ClassEval_RCI[[i]][["agreement"]][[2]]
}
#save(SenSpezSumm_RCI, file = "cor_04_k20/EMA_SenSpezSumm_RCI.RData")
#load("cor_04_k20/EMA_SenSpezSumm_RCI.RData")
SenSpezSumm_RCI %>%
mutate(across(.cols = where(is.numeric), .fns = round, digits = 2)) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Frequency | Method | Sens_imp | Sens_not | Sens_det | Spec_imp | Spec_not | Spec_det | Sensitivity_cwa | Specificity_cwa | SenSpec_mean | Accuracy_PercAgree | Kappa |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 30.30 | RCI_ind_preSD_30.30 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 |
| 5.5 Window | RCI_ind_preSD_5.5_Window | 0.80 | 0.92 | 0.74 | 0.93 | 0.80 | 0.99 | 0.82 | 0.90 | 0.86 | 0.89 | 0.72 |
| 5.5 Days | RCI_ind_preSD_5.5_Days | 0.79 | 0.86 | 0.63 | 0.88 | 0.79 | 0.99 | 0.75 | 0.88 | 0.81 | 0.84 | 0.61 |
Statt wenige zufällige MZP-Kombinationen zu ziehen und diese dann mit den “wahren” Schätzwerten und Klassifikationen (= berechnet anhand der gesamten Intervalle mit je 30 MZP) zu vergleichen, sollen die empirische Verteilung der Parameter und somit der Schätzfehler über Resampling-Methoden wie Jackknife-Verfahren und Bootstrapping berechnet werden.
Percentage Change (PC)
###### EMA_30.30
n = 30
Mean_PC = function(x, ID_df) {(1-((mean(ID_df[x,2])) / (mean(ID_df[x,1])))) * 100}
for (i in 1:nrow(EMA_30.30)) {
df = data.frame(PRE = as.numeric(EMA_30.30[i,pre_30mzp]), POST = as.numeric(EMA_30.30[i,post_30mzp]))
EMA_30.30[i,"Mean_PC_jse"] = jackknife(1:n, Mean_PC, df)$jack.se
EMA_30.30[i,"Mean_PC_jbias"] = jackknife(1:n, Mean_PC, df)$jack.bias
message(i)
}
EMA_30.30_Mean_PC_JK = EMA_30.30 %>%
select(ID, Mean_PC_jse, Mean_PC_jbias)
save(EMA_30.30_Mean_PC_JK, file = "Jackknife/EMA_30.30_Mean_PC_JK_k20.RData")
###### EMA_5.5_Window
n = 5
Mean_PC = function(x, ID_df) {(1-((mean(ID_df[x,2])) / (mean(ID_df[x,1])))) * 100}
for (i in 1:nrow(EMA_5.5_Window)) {
df = data.frame(PRE = as.numeric(EMA_5.5_Window[i,pre_5mzp]), POST = as.numeric(EMA_5.5_Window[i,post_5mzp]))
EMA_5.5_Window[i,"Mean_PC_jse"] = jackknife(1:n, Mean_PC, df)$jack.se
EMA_5.5_Window[i,"Mean_PC_jbias"] = jackknife(1:n, Mean_PC, df)$jack.bias
message(i)
}
EMA_5.5_Window_Mean_PC_JK = EMA_5.5_Window %>%
select(ID, Mean_PC_jse, Mean_PC_jbias)
save(EMA_5.5_Window_Mean_PC_JK, file = "Jackknife/EMA_5.5_Window_Mean_PC_JK_k20.RData")
###### EMA_5.5_Days
n = 5
Mean_PC = function(x, ID_df) {(1-((mean(ID_df[x,2])) / (mean(ID_df[x,1])))) * 100}
for (i in 1:nrow(EMA_5.5_Days)) {
df = data.frame(PRE = as.numeric(EMA_5.5_Days[i,pre_5mzp]), POST = as.numeric(EMA_5.5_Days[i,post_5mzp]))
EMA_5.5_Days[i,"Mean_PC_jse"] = jackknife(1:n, Mean_PC, df)$jack.se
EMA_5.5_Days[i,"Mean_PC_jbias"] = jackknife(1:n, Mean_PC, df)$jack.bias
message(i)
}
EMA_5.5_Days_Mean_PC_JK = EMA_5.5_Days %>%
select(ID, Mean_PC_jse, Mean_PC_jbias)
save(EMA_5.5_Days_Mean_PC_JK, file = "Jackknife/EMA_5.5_Days_Mean_PC_JK_k20.RData")load("Jackknife/EMA_30.30_Mean_PC_JK_k20.RData")
load("Jackknife/EMA_5.5_Window_Mean_PC_JK_k20.RData")
load("Jackknife/EMA_5.5_Days_Mean_PC_JK_k20.RData")
EMA_30.30 = full_join(EMA_30.30, EMA_30.30_Mean_PC_JK, by = "ID")
EMA_5.5_Window = full_join(EMA_5.5_Window, EMA_5.5_Window_Mean_PC_JK, by = "ID")
EMA_5.5_Days = full_join(EMA_5.5_Days, EMA_5.5_Days_Mean_PC_JK, by = "ID")
temp = tibble(Jackknife_SE = c(EMA_30.30$Mean_PC_jse, EMA_5.5_Window$Mean_PC_jse, EMA_5.5_Days$Mean_PC_jse),
Datasets = as_factor(rep(c("EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days"), each = length(EMA_30.30$Mean_PC_jse))))#<<
temp %>%
ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
geom_histogram(alpha = 0.2, position = "identity") +
labs(x = "Jackknife SE of Mean Percentage Change", y = "Cases") +
theme_gray()#<<#ggsave("Plots/k20_EMA_Mean_PC_JK_SE.jpg", width = 6, height = 4)#<<
temp %>%
ggplot(aes(x = Datasets, y = Jackknife_SE)) +
geom_boxplot(fill = "dodgerblue", na.rm = TRUE, outlier.size = 1) +
labs(x = "Dataset", y = "Jackknife SE of Mean Percentage Change") +
theme_gray()#<<#ggsave("Plots/k20_EMA_Mean_PC_JK_SE_Box.jpg", width = 6, height = 4)#<<
temp = tibble(Jackknife_Bias = c(EMA_30.30$Mean_PC_jbias, EMA_5.5_Window$Mean_PC_jbias, EMA_5.5_Days$Mean_PC_jbias),
Datasets = as_factor(rep(c("EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days"), each = length(EMA_30.30$Mean_PC_jbias))))#<<
temp %>%
ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
geom_histogram(alpha = 0.2, position = "identity") +
labs(x = "Jackknife Bias of Mean Percentage Change", y = "Cases") +
theme_gray()#<<#ggsave("Plots/k20_EMA_Mean_PC_JK_Bias.jpg", width = 6, height = 4)#<<
#temp %>%
# ggplot(aes(x = Datasets, y = Jackknife_Bias)) +
# geom_boxplot(fill = "dodgerblue", na.rm = TRUE, outlier.size = 1) +
# labs(x = "Dataset", y = "Jackknife Bias of Mean Percentage Change") +
# theme_gray()#<<
#ggsave("Plots/k20_EMA_Mean_PC_JK_Bias_Box.jpg", width = 6, height = 4)#<<RCI(ind) nur mit SD aus dem individuellen Pre-Intervall
###### EMA_30.30
n = 30
RCI_ind_preSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) /
sqrt(2 * (sd(ID_df[x,1]) * sqrt(1 - EMA_5.5_Alpha))^2)}
for (i in 1:nrow(EMA_30.30)) {
df = data.frame(PRE = as.numeric(EMA_30.30[i,pre_30mzp]), POST = as.numeric(EMA_30.30[i,post_30mzp]))
EMA_30.30[i,"RCI_ind_preSD_jse"] = jackknife(1:n, RCI_ind_preSD, df)$jack.se
EMA_30.30[i,"RCI_ind_preSD_jbias"] = jackknife(1:n, RCI_ind_preSD, df)$jack.bias
message(i)
}
EMA_30.30_RCI_ind_preSD_JK = EMA_30.30 %>%
select(ID, RCI_ind_preSD_jse, RCI_ind_preSD_jbias)
save(EMA_30.30_RCI_ind_preSD_JK, file = "Jackknife/EMA_30.30_RCI_ind_preSD_JK_k20.RData")
###### EMA_5.5_Window
n = 5
RCI_ind_preSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) /
sqrt(2 * (sd(ID_df[x,1]) * sqrt(1 - EMA_5.5_Alpha))^2)}
for (i in 1:nrow(EMA_5.5_Window)) {
df = data.frame(PRE = as.numeric(EMA_5.5_Window[i,pre_5mzp]), POST = as.numeric(EMA_5.5_Window[i,post_5mzp]))
EMA_5.5_Window[i,"RCI_ind_preSD_jse"] = jackknife(1:n, RCI_ind_preSD, df)$jack.se
EMA_5.5_Window[i,"RCI_ind_preSD_jbias"] = jackknife(1:n, RCI_ind_preSD, df)$jack.bias
message(i)
}
EMA_5.5_Window_RCI_ind_preSD_JK = EMA_5.5_Window %>%
select(ID, RCI_ind_preSD_jse, RCI_ind_preSD_jbias)
save(EMA_5.5_Window_RCI_ind_preSD_JK, file = "Jackknife/EMA_5.5_Window_RCI_ind_preSD_JK_k20.RData")
###### EMA_5.5_Days
n = 5
RCI_ind_preSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) /
sqrt(2 * (sd(ID_df[x,1]) * sqrt(1 - EMA_5.5_Alpha))^2)}
for (i in 1:nrow(EMA_5.5_Days)) {
df = data.frame(PRE = as.numeric(EMA_5.5_Days[i,pre_5mzp]), POST = as.numeric(EMA_5.5_Days[i,post_5mzp]))
EMA_5.5_Days[i,"RCI_ind_preSD_jse"] = jackknife(1:n, RCI_ind_preSD, df)$jack.se
EMA_5.5_Days[i,"RCI_ind_preSD_jbias"] = jackknife(1:n, RCI_ind_preSD, df)$jack.bias
message(i)
}
EMA_5.5_Days_RCI_ind_preSD_JK = EMA_5.5_Days %>%
select(ID, RCI_ind_preSD_jse, RCI_ind_preSD_jbias)
save(EMA_5.5_Days_RCI_ind_preSD_JK, file = "Jackknife/EMA_5.5_Days_RCI_ind_preSD_JK_k20.RData")load("Jackknife/EMA_30.30_RCI_ind_preSD_JK_k20.RData")
load("Jackknife/EMA_5.5_Window_RCI_ind_preSD_JK_k20.RData")
load("Jackknife/EMA_5.5_Days_RCI_ind_preSD_JK_k20.RData")
EMA_30.30 = full_join(EMA_30.30, EMA_30.30_RCI_ind_preSD_JK, by = "ID")
EMA_5.5_Window = full_join(EMA_5.5_Window, EMA_5.5_Window_RCI_ind_preSD_JK, by = "ID")
EMA_5.5_Days = full_join(EMA_5.5_Days, EMA_5.5_Days_RCI_ind_preSD_JK, by = "ID")
temp = tibble(Jackknife_SE = c(EMA_30.30$RCI_ind_preSD_jse, EMA_5.5_Window$RCI_ind_preSD_jse, EMA_5.5_Days$RCI_ind_preSD_jse),
Datasets = as_factor(rep(c("EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days"), each = length(EMA_30.30$RCI_ind_preSD_jse))))#<<
temp %>%
ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
geom_histogram(alpha = 0.2, position = "identity") +
labs(x = "Jackknife SE of RCI(ind) With Pre-SDs", y = "Cases") +
theme_gray()#<<#ggsave("Plots/k20_EMA_RCI_ind_preSD_JK_SE.jpg", width = 6, height = 4)#<<
temp %>%
ggplot(aes(x = Datasets, y = Jackknife_SE)) +
geom_boxplot(fill = "dodgerblue", na.rm = TRUE, outlier.size = 1) +
labs(x = "Dataset", y = "Jackknife SE of RCI(ind) With Pre-SDs") +
theme_gray()#<<#ggsave("Plots/k20_EMA_RCI_ind_preSD_JK_SE_Box.jpg", width = 6, height = 4)#<<
temp = tibble(Jackknife_Bias = c(EMA_30.30$RCI_ind_preSD_jbias, EMA_5.5_Window$RCI_ind_preSD_jbias,
EMA_5.5_Days$RCI_ind_preSD_jbias),
Datasets = as_factor(rep(c("EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days"),
each = length(EMA_30.30$RCI_ind_preSD_jbias))))#<<
temp %>%
ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
geom_histogram(alpha = 0.2, position = "identity") +
labs(x = "Jackknife Bias of RCI(ind) With Pre-SDs", y = "Cases") +
theme_gray()#<<#ggsave("Plots/k20_EMA_RCI_ind_preSD_JK_Bias.jpg", width = 6, height = 4)#<<
#temp %>%
# ggplot(aes(x = Datasets, y = Jackknife_Bias)) +
# geom_boxplot(fill = "dodgerblue", na.rm = TRUE, outlier.size = 1) +
# labs(x = "Dataset", y = "Jackknife Bias of RCI(ind) With Pre-SDs") +
# theme_gray()#<<
#ggsave("Plots/k20_EMA_RCI_ind_preSD_JK_Bias_Box.jpg", width = 6, height = 4)#<<RCI(ind) mit pooled SDs aus beiden individuellen Intervallen
###### EMA_30.30
n = 30
RCI_ind_pooledSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) /
sqrt((sd(ID_df[x,1])^ 2 + sd(ID_df[x,2])^ 2) * (1 - EMA_5.5_Alpha))}
for (i in 1:nrow(EMA_30.30)) {
df = data.frame(PRE = as.numeric(EMA_30.30[i,pre_30mzp]), POST = as.numeric(EMA_30.30[i,post_30mzp]))
EMA_30.30[i,"RCI_ind_pooledSD_jse"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.se
EMA_30.30[i,"RCI_ind_pooledSD_jbias"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.bias
message(i)
}
EMA_30.30_RCI_ind_pooledSD_JK = EMA_30.30 %>%
select(ID, RCI_ind_pooledSD_jse, RCI_ind_pooledSD_jbias)
save(EMA_30.30_RCI_ind_pooledSD_JK, file = "Jackknife/EMA_30.30_RCI_ind_pooledSD_JK_k20.RData")
###### EMA_5.5_Window
n = 5
RCI_ind_pooledSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) /
sqrt((sd(ID_df[x,1])^ 2 + sd(ID_df[x,2])^ 2) * (1 - EMA_5.5_Alpha))}
for (i in 1:nrow(EMA_5.5_Window)) {
df = data.frame(PRE = as.numeric(EMA_5.5_Window[i,pre_5mzp]), POST = as.numeric(EMA_5.5_Window[i,post_5mzp]))
EMA_5.5_Window[i,"RCI_ind_pooledSD_jse"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.se
EMA_5.5_Window[i,"RCI_ind_pooledSD_jbias"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.bias
message(i)
}
EMA_5.5_Window_RCI_ind_pooledSD_JK = EMA_5.5_Window %>%
select(ID, RCI_ind_pooledSD_jse, RCI_ind_pooledSD_jbias)
save(EMA_5.5_Window_RCI_ind_pooledSD_JK, file = "Jackknife/EMA_5.5_Window_RCI_ind_pooledSD_JK_k20.RData")
###### EMA_5.5_Days
n = 5
RCI_ind_pooledSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) /
sqrt((sd(ID_df[x,1])^ 2 + sd(ID_df[x,2])^ 2) * (1 - EMA_5.5_Alpha))}
for (i in 1:nrow(EMA_5.5_Days)) {
df = data.frame(PRE = as.numeric(EMA_5.5_Days[i,pre_5mzp]), POST = as.numeric(EMA_5.5_Days[i,post_5mzp]))
EMA_5.5_Days[i,"RCI_ind_pooledSD_jse"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.se
EMA_5.5_Days[i,"RCI_ind_pooledSD_jbias"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.bias
message(i)
}
EMA_5.5_Days_RCI_ind_pooledSD_JK = EMA_5.5_Days %>%
select(ID, RCI_ind_pooledSD_jse, RCI_ind_pooledSD_jbias)
save(EMA_5.5_Days_RCI_ind_pooledSD_JK, file = "Jackknife/EMA_5.5_Days_RCI_ind_pooledSD_JK_k20.RData")load("Jackknife/EMA_30.30_RCI_ind_pooledSD_JK_k20.RData")
load("Jackknife/EMA_5.5_Window_RCI_ind_pooledSD_JK_k20.RData")
load("Jackknife/EMA_5.5_Days_RCI_ind_pooledSD_JK_k20.RData")
EMA_30.30 = full_join(EMA_30.30, EMA_30.30_RCI_ind_pooledSD_JK, by = "ID")
EMA_5.5_Window = full_join(EMA_5.5_Window, EMA_5.5_Window_RCI_ind_pooledSD_JK, by = "ID")
EMA_5.5_Days = full_join(EMA_5.5_Days, EMA_5.5_Days_RCI_ind_pooledSD_JK, by = "ID")
temp = tibble(Jackknife_SE = c(EMA_30.30$RCI_ind_pooledSD_jse, EMA_5.5_Window$RCI_ind_pooledSD_jse,
EMA_5.5_Days$RCI_ind_pooledSD_jse),
Datasets = as_factor(rep(c("EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days"),
each = length(EMA_30.30$RCI_ind_pooledSD_jse))))#<<
temp %>%
ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
geom_histogram(alpha = 0.2, position = "identity") +
labs(x = "Jackknife SE of RCI(ind) With Pooled SDs", y = "Cases") +
theme_gray()#<<#ggsave("Plots/k20_EMA_RCI_ind_pooledSD_JK_SE.jpg", width = 6, height = 4)#<<
temp %>%
ggplot(aes(x = Datasets, y = Jackknife_SE)) +
geom_boxplot(fill = "dodgerblue", na.rm = TRUE, outlier.size = 1) +
labs(x = "Dataset", y = "Jackknife SE of RCI(ind) With Pooled SDs") +
theme_gray()#<<#ggsave("Plots/k20_EMA_RCI_ind_pooledSD_JK_SE_Box.jpg", width = 6, height = 4)#<<
temp = tibble(Jackknife_Bias = c(EMA_30.30$RCI_ind_pooledSD_jbias, EMA_5.5_Window$RCI_ind_pooledSD_jbias,
EMA_5.5_Days$RCI_ind_pooledSD_jbias),
Datasets = as_factor(rep(c("EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days"),
each = length(EMA_30.30$RCI_ind_pooledSD_jbias))))#<<
temp %>%
ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
geom_histogram(alpha = 0.2, position = "identity") +
labs(x = "Jackknife Bias of RCI(ind) With Pooled SDs", y = "Cases") +
theme_gray()#<<#ggsave("Plots/k20_EMA_RCI_ind_pooledSD_JK_Bias.jpg", width = 6, height = 4)#<<
#temp %>%
# ggplot(aes(x = Datasets, y = Jackknife_Bias)) +
# geom_boxplot(fill = "dodgerblue", na.rm = TRUE, outlier.size = 1) +
# labs(x = "Dataset", y = "Jackknife Bias of RCI(ind) With Pooled SDs") +
# theme_gray()#<<
#ggsave("Plots/k20_EMA_RCI_ind_pooledSD_JK_Bias_Box.jpg", width = 6, height = 4)#<<